         SYSTEM   BPM               ALLOW M: INSTRUCTIONS               LIO
         SYSTEM   SIG7FDP                                               LIO
2%TABLES CNAME
* A PROC TO GENERATE TWO BYTE TABLES FROM PAIRS OF ARGUMENTS
         PROC
LF(1)    EQU      %
         DATA,1   0
I        DO       NUM(AF)
         DATA,1   AF(I,1)
         FIN
         BOUND    4
LF(2)    EQU      %
         DATA,1   0
I        DO       NUM(AF)
         DATA,1   AF(I,2)-BASE
         FIN
         BOUND    4
         PEND
* DEFS FOR C:LIO
         DEF      C:ERA,C:ABA,C:RLR,C:WLR,C:WOB,C:CIB,C:LBL,C:CLS,C:OPN
         DEF      OPEN                                                  C:LIO

         DEF     CLOSE,CVOL,READ                                        C:LIO

         DEF      C:ALLC                                                C:LIO *
FUN      EQU      5                                                     C:LIO *
BLOCKSZ  EQU      4                                                     C:LIO *
KEY      EQU      14                                                    C:LIO *
BLOKK    EQU      15                                                    C:LIO *
RDISP    EQU      14                                                    C:LIO *
LAST%BLK EQU      5                                                     C:LIO *
HIGH%BLK EQU      3                                                     C:LIO *
RSTORE   EQU      20                                                    C:LIO *
BLOK%CNT DATA     0                                                     C:LIO *
KEYSV    DATA     0                                                     C:LIO *
SIZAA    DATA     0                                                     C:LIO *
NOISE    EQU      12
FCN      EQU      28                                                    C:LIO

TYC      EQU      9                                                     C:LIO

DECLARE  EQU      X'40000'                                              C:LIO

C:LBL    EQU      ERROR%XX                                              C:LIO

* EQUATES FOR C:LIO
LOCKED   EQU      X'10'             LOCKED FILE INDICATOR
DELETE   EQU      X'40'             RELEASE FILE INDICATOR              LIO
NO%RWD%CLS EQU 8                    CLOSE NO REWIND INDICATOR
STATS    EQU      4
FIST     EQU      6                 FILE INFO TABLE ADDRESS REGISTER
ERROR    EQU      7                 ERROR CODE REGISTER
LNK2     EQU      9                 INTERNAL LINK REGISTER
INDX1    EQU      7                 INDEX REGISTER
OPTN     EQU      14                OPTION REGISTER
RECD     EQU      15                 RECORD ADDTESS FOR FPT
ODD      EQU      13                ODD REGISTER OF EVEN/ODD PAIR
EVEN     EQU      12                EVEN REGISTER OF EVEN/ODD PAIR
DISP     EQU      1                 DISPLACEMENT WITHIN BUFFER
WORK     EQU      DISP              AVAILABLE TEMPORARY WORK REGISTER
FROM     EQU      4                 FROM REGISTER FOR MBS
BUFF     EQU      FROM
TO       EQU      FROM+1            TO  REGISTER FOR MBS
SIZE     EQU      2                 SIZE OF RECORD FOR FPT
LINK     EQU      11                LINK REGISTER
FLAG2    EQU      X'20'             REVERSED FLAG FOR FPT
OUTPUT   EQU      X'20000'          OUTPUT OPERATION INDUC
REVERSED EQU      FLAG2
LOCK%ERR EQU      X'8F'
NO%BUF   EQU      X'A2'
NO%RWD   EQU      X'100'
DCB%ADR  EQU      0                 DCBADDRESS
CBUF%ADR EQU      2                 CURRENT BUFFER ADDRESS
ABUF%ADR EQU      5                 ALTERNATE BUFFER ADDRESS
CUR%CNT  EQU      3                 CURRENT RECORD COUNT
REC%ADR  EQU      6                 LOGICAL RECORD ADDRESS
CUR%DISP EQU      2                 CURREN RECORD DISPLACEMENT
CUR%SIZE EQU      5                 CURREN BLOCK SIZE
MAX%SIZE EQU      6                 MAXIMUM RECORD SIZE
STATUS   EQU      1                 FILE STATUS
DCB      EQU      3                 DCB ADDRESS REGISTER
ENDED    EQU      X'20000'          EOF ENCOUNTERED FLAG
CLS%REEL EQU      X'220'             CLOSE REEL FLAG
KEYD%DIR EQU      X'22'
SR1      EQU      8
OPTIONAL EQU      X'80'
CLOSED   EQU      X'200'
C:ERA    EQU      C:ABA
SR3      EQU      10
DCB%COS  EQU      44                CIS COS OR VNO, BYTE 1 OF WORD 11   LIO
         PAGE
* MISCELLANEOUS DATA FOR C:LIO
SAVEM    RES      16                REGISTER SAVE AREA
DISPLACE DATA     0                 HOLD AREA FOR RECORD DISPLACEMENT
SIZA     DATA      0
NEXT%BUF DATA      0
READ%FWD DATA     X'20000008'                                           C:LIO

LINK%SV  DATA     0
LNK2%HLD DATA     0
         BOUND    8
MY%LIMITS DATA    SAVEM,MY%END
         PAGE
* F P T ' S   F O R   C : L I O
*
OPEN     DATA     X'94000000'+DCB   M:OPEN * DCB
         DATA     X'C1400000'                                           C:LIO

         DATA     C:ERA                                                 C:LIO

         DATA     C:ABA                                                 C:LIO

OPN%MODE DATA     0                 OUTIN/INOUT/OUT/IN
         DATA     X'00000002'       SAVE
         DATA     0                                                     C:LIO

*                                                                       C:LIO
*                                                                       C:LIO
OPEN:IO  GEN,8,24 X'94',DCB                                             C:LIO
         DATA     X'C3480000',C:ERA,C:ABA                               C:LIO
         DATA     2                                                     C:LIO
         GEN,4,28 8,OPN%MODE                                            C:LIO
         DATA     2                                                     C:LIO
         GEN,4,28 8,LNK2                                                C:LIO
*
* ALL OTHER PARAMETERS ASSUMED IN DCB INITIALLY FOR OPEN
*
PFIL     DATA     X'9C000000'+DCB    M:PFIL *DCB
         DATA     X'00000010'       BOF
*
*
*
PFIL%REV DATA     X'9C000000'+DCB    M:PFIL * DCB
         DATA     0                 EOF
REWIND   DATA     X'81000000'+DCB    M:REW *DCB
*
*
*
CLOSE    DATA     X'95000000'+DCB    M:CLOSE *DCB
         DATA     X'80000000'
         DATA     X'00000002'       SAVE
         DATA     0                                                     C:LIO

*
*
*
READ     DATA     X'90000000'+DCB     M:READ *DCB
READ%FLG EQU      READ+1
         DATA     X'20000000'
         DATA     X'80000000'+RECD  BUF,*RECD
*
*
*
WRITE    DATA     X'91000000'+DCB    M:WRITE *DCV
         DATA     X'30000040'       ONEWKEY
         DATA     X'80000000'+RECD  BUF,*RECD
         DATA     X'80000000'+SIZE  SIZE,*SIZE
*                                                                       C:LIO

*                                                                       C:LIO

*                                                                       C:LIO

WRITLBL  GEN,8,24 X'91',DCB                                             C:LIO

         GEN,4,28 X'F',X'40'                                            C:LIO

         DATA     ERR%RTN,ABNORM                                        C:LIO

         GEN,4,28 8,RECD                                                C:LIO

         GEN,4,28 8,SIZE                                                C:LIO

WRIYT    RES      0                                                     C:LIO *
         CI,DCB   X'40000'                                              C:LIO *
         BANZ     RANDORG                                               C:LIO *
         CW,DCB   =X'80000'         USER LABELS                         C:LIO
         BAZ      *LNK2             NO                                  C:LIO
         CAL1,1   WRITLBL                                               C:LIO

         AI,LNK2  1                                                     C:LIO

         B        *LNK2                                                 C:LIO

*
*
*
CHECK    DATA     X'A9000000'+DCB    M:CHECK *DCB
         DATA     X'C0000000'
        DATA      ERR%RTN
         DATA     ABNORM
*
*
*
NULL%CHK DATA     X'A9000000'+DCB   M:CHECK *DCB
         DATA     X'C0000000'
         DATA     NULL              ERROR DO NOTHING
         DATA     NULL              ABNORMAL, DO NOTHING
NULL     B        *SR1              NULL ERROR ABNORMAL HANDLER
*
*
*
WRITKEY  DATA     X'91000000'+DCB   M:WRITE *DCB
         DATA     X'38000060'  AD
         DATA     X'80000000'+RECD  BUF,*RECD
         DATA     X'80000000'+SIZE  SIZE,*SIZE
         DATA     X'80000000'+KAD
READ%KEY DATA     X'90000000'+DCB   M:READ *DCB
         DATA     X'28000040'
         DATA     X'80000000'+RECD  BUF,*RECD
         DATA     X'80000000'+KAD
*
*
*
CVOL     DATA     X'83000000'+DCB   M:CVOL  *DCB
         DATA     0                                                     C:LIO

         DATA     0                                                     C:LIO

*
*
*
KAD      DATA     0
*
*
*
GET%PAGE DATA     X'08000001'       M:GP 1
*
*
*
LBL%I%O  DATA     DCB
         DATA     X'30000000'
LBL%AREA DATA     0                                                     C:LIO

         DATA     X'80000000'+SIZE
*
*
*
PRECORD%REV DATA  X'9D000000'+DCB   M:PRECORD *DCB
         DATA     X'10'
*
*
*
WEOF     DATA     X'82000000'+DCB   M:WEOF   *DCB
*                                                                       C:LIO

*                                                                       C:LIO

*                                                                       C:LIO

PRECORD  GEN,8,24 X'9D',DCB                                             C:LIO

         DATA     0                                                     C:LIO

         REF      M:DO                                                  C:LIO

DIAGOUT  GEN,8,24 X'11',M:DO        M:WRITE M:DO,(BUF,MESSG),(SIZE,*15) C:LIO

         GEN,4,28 3,0                                                   C:LIO

         GEN,32   MESSG                                                 C:LIO

         GEN,32   40                                                    C:LIO

MESSG    TEXT     ' PROGRAM ABORTED--ERROR CODE'                        C:LIO

ERR%CODE TEXT     '           '         FORTY CHARACTERS TO HERE        C:LIO

SPACE1   GEN,8,24 X'11',M:DO        M:WRITE M:DO,(BUF=SPACEBUF)         C:LIO
         GEN,4,28 3,0
         GEN,32   SPACEBUF
         GEN,32   2
SPACEBUF TEXT     '  '              DUMMY SPACE LINE
DCB%PTR  RES      1                                                     C:LIO

DCB%LNK  RES      1                                                     C:LIO

RANDIO   DATA     DCB                                                   C:LIO *
         GEN,8,24 X'F1',0                                               C:LIO *
         DATA     C:ERA,C:ABA                                           C:LIO *
         GEN,1,31 1,RECD                                                C:LIO *
         GEN,1,31 1,SIZE                                                C:LIO *
         GEN,1,31 1,WORK                                                C:LIO *
         PAGE
IO%CODES,IO%RTNS  2%TABLES (X'05',EOD%HERE),(X'06',EOF%HERE),;
                  (X'04',ABN%IF%REV),(X'1D',ABN%IF%REV),;
                  (X'13',ABN%IF%IO),(X'56',EOF%HERE),(X'1C',EOT%HERE),;
                  (X'43',ABN%IF%IO),(X'0A',WAS%56),;
                  (X'01',IF%OPTIONAL%OK),(X'14',IF%OPTIONAL%OK),;
                  (X'57',EOF%HERE),;                                    C:LIO *
                  (X'42',INV%KEY),;                                     C:LIO *
                   (X'8C',SORT%ERR),(X'8D',SORT%ERR),(X'90',REP%ERR),;  C:LIO
                  (X'16',EOF%HERE),;                                    C:LIO *
                   (X'91',REP%ERR),(X'92',REP%ERR),(X'9E',PROC%ERR),;   C:LIO
                  (X'03',IF%OPTIONAL%OK),(X'46',EOF%IF%OPTIONAL),;      LIO
                  (X'4E',ANS%BLKCNT),(X'9A',PROC%ERR)
CHECKER  LI,INDX1 FCN                                                   C:LIO

         LB,WORK  *DCB,INDX1        WAIT FOR I/O COMPLETE               C:LIO

         BNEZ     CHEX                                                  C:LIO
         LI,INDX1 TYC                                                   C:LIO

         LB,WORK  *DCB,INDX1                                            C:LIO

         CI,WORK  3                 CHECK TYPE COMPLETION               C:LIO
         BLE      *LNK2             NORMAL GO BACK                      C:LIO
CHEX     RES      0                                                     C:LIO
         CAL1,1   CHECK             NOT NORMAL, DO M:CHECK              C:LIO

         B        *LNK2                                                 C:LIO

         PAGE
* OPEN PROCESSING
C:OPN    EQU      %
         LCI      0                                                     C:LIO

         STM,0    SAVEM             SAVE THE REGISTERS                  C:LIO

         MTB,1    FIST              SET OPEN/CLOSE FLAG                 C:LIO

         BAL,LNK2 CHK%LOCK          CHECK FOR FILE LOCKED               C:LIO

         BAL,LNK2 ZRO               ZERO CURRENT SIZE AND DISPLACEMENT
         LI,RECD  7
         STS,OPTN OPN%MODE            IN FPT
         LI,LNK2  X'F0'                                        EL31774  LIO
         AND,LNK2 5,DCB             GET ORG OR FMT AND ACS     EL31774  LIO
         LI,WORK  X'F'                                                  LIO
         AND,WORK 0,DCB             ASN FIELD                           LIO
         CI,WORK  X'A'                                         EL31774  LIO
         BNE      AFTANS            JUMP IF NOT ANSLBL TAPE    EL31774  LIO
         LW,WORK  SAVEM+6           GET ADDR OF I: AREA        SP26669 LIO
         AI,WORK  1                 COMPUTE ADDR OF 2ND WORD    SP26669 LIO
         LB,WORK  *WORK             1ST BYTE HAS BUF COUNT     SP26669 LIO
         STB,WORK *FIST             SET DOUBLE BUFF            EL31774  LIO
         CI,LNK2  X'30'                                        EL31774  LIO
         BNE      AFTANS            JUMP IF NOT VARIABLE RCD   EL31774  LIO
         LW,WORK  =X'00800000'                                 EL31774  LIO
         STS,WORK STATUS,FIST       SET FLAG FOR ANS VAR RCD   EL31774  LIO
AFTANS   RES      0                                                     LIO
         LI,WORK  X'F'                                                  LIO
         AND,WORK 0,DCB             LOOK AT ASN                         LIO
         CI,WORK  1                 SEE IF FILE DCB                     LIO
         BNE      DO%OPN            NO                                  LIO
         LI,LNK2  X'FF'                                                 LIO
         AND,LNK2 5,DCB             LOOK AT ACS                         LIO
         CI,LNK2  X'22'             SEE IF RANDOM
         BNE      DO%OPN            NO DO NOT USE KEYM                  LIO
         LI,WORK  48                NO. GET KEYM                        C:LIO
         LB,LNK2  *DCB,WORK         FROM DCB                            C:LIO
         STB,LNK2 *FIST             AND SAVE IT FOR NEXT OPEN           C:LIO
DO%IOPN  RES      0                                                     C:LIO
         CAL1,1   OPEN:IO                                               C:LIO
         B        OPEN%OK                                               C:LIO
DO%OPN   RES      0                                                     C:LIO
         CAL1,1   OPEN              OPEN THE DCB
OPEN%OK  EQU      %
         LI,INDX1 2*STATUS+1        UPDATE STATUS WORD
         STH,OPTN *FIST,INDX1       IN FPT
         CI,OPTN  NO%RWD            IF NO REWI ND SPECIFIED
         BANZ     ALLOCATE           ...DON'T REWIND (CLEVER,HUH)
         CI,OPTN  REVERSED          IF
         BAZ      POSITION           OPEN REVERSED
         LI,ODD   3                  TO A DEVICE                        C:LIO

         CS,ODD   *DCB                DO NO                             C:LIO

         BE       ALLOCATE                                              C:LIO *
         CAL1,1   PFIL%REV          POSITION TO EOF
         B        ALLOCATE
POSITION EQU      %                   ELSE
         LI,ODD   3                 IF NOT ASSIGNED                     C:LIO

         CS,ODD   *DCB                TO A DEVICE                       C:LIO

         BNE      ALLOCATE          DON'T BOTHER TO PFIL                C:LIO

*                                      ... PTL ALREADY DID IT           C:LIO

         CAL1,1   PFIL              POSITION TO BOF
C:LABL   EQU      %                 LABEL PROCESSING IF NEEDED          C:LIO

         LW,WORK  =X'200000'                                            C:LIO

         CW,WORK  STATUS,FIST                                           C:LIO

         BAZ      LBL%DONE          NOT LAB REC DANM.. GET OUT...       C:LIO

         LW,ODD   =X'80000'         SET ULBL FLAG                       C:LIO
         STS,ODD  0,FIST                                                C:LIO
         LI,WORK  X'90'             SET INPUT LABEL                     C:LIO

         CI,OPTN  2                                                     C:LIO

         BAZ      LBL%IN                                                C:LIO

         LW,ODD   OPEN+6                                                C:LIO

         BNEZ     %+2
         LI,ODD   LBL%IO
         LI,WORK  X'91'             OR OUTPUT LABEL                     C:LIO

         LB,SIZE  *ODD
LBL%IO   EQU      %                                                     C:LIO

         STW,ODD  LBL%AREA                                              C:LIO

         STB,WORK LBL%I%O                                               C:LIO

         CAL1,1   LBL%I%O           DO LABEL I/O                        C:LIO

         BAL,LNK2 CHECKER           CHECK FOR ERROR                     C:LIO

LBL%DONE EQU      %                                                     C:LIO

ALLOCATE EQU      %
         CAL1,1   NULL%CHK          CLEAR ABNORMAL OR ERROR
ALLCOM   EQU      %                 LABEL FOR ENTRY OF C:ALLC           LIO
* A L L O C A T E   B U F F E R S   A N D   P R I M E   T H E M
         LI,INDX1 4*STATUS          IF NOT A BLOCKED FILE
         LB,EVEN  *FIST,INDX1        NO BUFFERS TO ALLOCATE
         BEZ      *LINK              SO ***  EXIT ***
         LI,ODD   X'F'                                                  LIO
         AND,ODD  0,DCB                                                 LIO
         CI,ODD   X'A'              SEE IF ASN = A                      LIO
         BE       CHKBUF            JUMP IF AN ANS TAPE        EL31774  LIO
         LI,ODD   3                 IF NOT ASSIGNED                     C:LIO

         CS,ODD   *DCB               TO A DEVICE                        C:LIO

         BE       MAKESURE
NOTSURE  RES      0
         LI,INDX1 4*STATUS          SET INDEX REGISTER                  LIO
         LI,EVEN  X'F0'                                                 C:LIO *
         AND,EVEN 5,DCB                                                 C:LIO *
         CI,EVEN  X'30'             RANDOM FILE ORG                     C:LIO *
         BNE      UNSURE            NO. GO ON                           C:LIO *
         LI,EVEN  X'F'                                                  C:LIO
         AND,EVEN 0,DCB                                                 C:LIO
         CI,EVEN  1                 NOT FILE                            C:LIO
         BG       UNSURE            GO ON                               C:LIO
         LI,ODD   X'40000'          YES.                                C:LIO *
         STS,ODD  0,FIST            SET FLAG                            C:LIO *
         CAL1,1   CLOSE                                                 C:LIO
         LI,ODD   4                                                     C:LIO
         STW,ODD  OPN%MODE          INSURE RANDOM FILE ALWAYS I/O       C:LIO
         CAL1,1   OPEN                                                  C:LIO
         B        SNGL                                                  C:LIO *
UNSURE   RES      0                                                     C:LIO *
         LI,EVEN  0                 SET UP FOR NO BLOCKING BUFFER       C:LIO

         STB,EVEN *FIST,INDX1                                           C:LIO

         LW,FROM  3,DCB                                                 C:LIO

         LI,TO    X'E0000'      MASK = FFFE0000                         LIO
         CS,FROM  MAX%SIZE,FIST       WITH RECORD SIZE IN FIST          C:LIO

         BE       *LINK             IF THE SAME GET OUT                 C:LIO

         LI,ODD   X'F'              TEST IF DEVICE = TYPEWRITER
         AND,ODD  0,DCB
         CI,ODD   X'5'                BTM UC IS ASN = 5
         BE       *LINK
         BNE      SNGL                                                  LIO
         LI,ODD   3                                                     LIO
         CS,ODD   *DCB              ASN = 3, TYPE = 10 THEN UC DEVICE   LIO
         BE       *LINK             YES .. NO BUFFERING NEED APPLY
SNGL     RES      0                                                     C:LIO *
         LI,EVEN  X'01'                                                 C:LIO

         STB,EVEN *FIST,INDX1        OR ONE IF BLOCKED                  C:LIO

CHKIFBLK EQU      %                                                     C:LIO

         LI,ODD   X'FF'                                                 C:LIO *
         AND,ODD  5,DCB                                                 C:LIO *
         CI,ODD   KEYD%DIR                                              C:LIO *
         BE       *LINK
         LI,SIZE  X'E0000'           IF NOR RECORD SIZE
         AND,SIZE 6,FIST
         BNEZ     GO%ON
         STB,SIZE *FIST
         LI,INDX1 4
         STB,SIZE *FIST,INDX1
         B        *LINK
MAKESURE RES      0
         LW,WORK  6,DCB             FLP FIELD                           LIO
         MTW,0    WORK              ARE THERE VAR PARMS                 LIO
         BEZ      SNGL              NO, F00 IMP SFP 05-24-76            LIO
         LI,ODD   7                 SN INDICATOR                        LIO
DEVLOP   EQU      %                                                     LIO
         CB,ODD   *WORK             SEE IF SN                           LIO
         BE       CHKIFSN           FOUND                               LIO
         LI,INDX1 1                                                     LIO
         LB,SIZE  *WORK,INDX1                                           LIO
         CI,SIZE  1                 SEE IF LAST PARAMETER ENTRY         LIO
         BE       NOTSURE                                               LIO
         LI,INDX1 3                                                     LIO
         LB,SIZE  *WORK,INDX1                                           LIO
         AI,SIZE  1                 OFFSET TO NEXT ENTRY                LIO
         AWM,SIZE WORK              CHG POINTER                         LIO
         B        DEVLOP            LOOP THRU ENTRIES                   LIO
CHKIFSN  RES      0                                                     LIO
         LW,ODD   *WORK             SEE IF THIS IS REAL SN              LIO
         AND,ODD  =X'FF00'          MASK OFF NUMBER OF SN'S             LIO
         BGZ      CHKIFBLK          MUST REAL SN                        LIO
         B        NOTSURE           EXAMINE OTHER DEVICES               LIO
GO%ON    RES      0
         STB,EVEN *FIST               SET COUNT OF BUFFERS TO BE PRIMED
CHKBUF   RES      0                 FOR ANS LABEL TAPE         EL31774  LIO
         LW,BUFF  CBUF%ADR,FIST     IF BUFFERS ALREADY
         BNEZ     *LINK               ALLOCATED,  GET OUT
         LB,EVEN  *FIST             RESET  REGISTER                     LIO
         LW,SIZE  3,DCB             GET RSZ FROM DCB
         AI,SIZE  X'60000'           ROUND  TO WORDS
         SLS,SIZE -19                AND RIGHT JUSTIFY
         BAL,LNK2 GETBUF            GET A BUFFER THE RIGHT SIZE
         STW,BUFF CBUF%ADR,FIST     STORE BUFFER ADDRESS
         AI,EVEN  -1                UNLESS FILE
         BEZ      PRIME%IT           IS UNBUFFERED
         BAL,LNK2 GETBUF            GET THE SECOND BUFFER
PRIME%IT EQU      %
         LI,ODD   X'40000'                                              C:LIO *
         CW,ODD   0,FIST            IF RANDOM                           C:LIO *
         BAZ      ST%BF%2                                               C:LIO *
         LI,ODD   X'20000'                                              C:LIO *
         STS,ODD  DCB%ADR,FIST                                          C:LIO *
         CI,OPTN  2                   AND OUTPUT                        C:LIO *
         BAZ      RANCHK2                                               C:LIO *
         LW,ODD   =X'80000000'      SET ALL RECORDS OF BLOCK TO NULL    C:LIO *
         STW,ODD  HIGH%BLK,FIST                                         C:LIO *
         LW,INDX1 BLOCKSZ,FIST                                          C:LIO *
         LH,INDX1 INDX1                                                 C:LIO *
         LW,EVEN  MAX%SIZE,FIST                                         C:LIO *
         SLS,EVEN -17                                                   C:LIO *
         LI,ODD   X'FF'                                                 C:LIO *
BLK%INIT RES      0                                                     C:LIO *
         SW,INDX1 EVEN                                                  C:LIO *
         BLZ      *LINK                                                 C:LIO *
         STB,ODD  *BUFF,INDX1                                           C:LIO *
         B        BLK%INIT                                              C:LIO *
RANCHK2  RES      0                                                     C:LIO *
         LI,OPTN  2                                                     C:LIO *
         CW,OPTN  5,DCB             DIRECT ACCESS                       C:LIO *
         BANZ     *LINK             ENUFF DONE                          C:LIO *
ST%BF%2  RES      0                                                     C:LIO *
         STW,BUFF ABUF%ADR,FIST     STORE ALTERNATE BUFFER ADDRESS
         B        *LINK             *** EXIT ***
LBL%IN   EQU      %                                                     C:LIO

         LI,SIZE  X'FF'                                                 C:LIO

         LW,ODD   OPEN+6                                                C:LIO

         BNEZ     LBL%IO                                                C:LIO

         CAL1,1   PRECORD                                               C:LIO

         B        LBL%DONE-1                                            C:LIO

*    G E T   A   B U F F E R   A D D R E S S
GETBUF   EQU      %
         STW,LNK2 LNK2%HLD
GETBUFF  EQU      %
         CW,SIZE  SIZA              WHEN ENOUGH AVAILABLE SPACE FOR THE
         BLE      SET%ADRS           BUFFER GO GET THE ADDRESS
         CAL1,8   GET%PAGE            ELSE GET ANOTHER PAGE
         BCS,8    NO%ROOM             NO PAGE...GO BOOM                 C:LIO *
         LW,WORK  NEXT%BUF          IF NO BUFFER ADDRESS
         BEZ      SETBUF            JUMP IF FIRST PAGE REQUEST LIO      LIO
         AW,WORK  SIZA              ADD REM SIZE & LAST BUFF   EL31774  LIO
         CW,9     WORK              CHECK CONSECUTIVE PAGE ?   EL31774  LIO
         BE       SETSIZE           YES, JUMP TO SET SIZE      EL31774  LIO
SETBUF   STW,9    NEXT%BUF          NO, IGNORE REST OF LAST BUFF        LIO
         LI,WORK  512               RESET BUFF ADDR & SIZE     EL31774  LIO
         STW,WORK SIZA                FOR CURRENT BUFF         EL31774  LIO
         B        GETBUFF           GO GET NEXT PAGE IF NEEDED EL31774  LIO
SETSIZE  LI,WORK  512               ADD SIZE OF ONE PAGE TO    EL31774  LIO
         AWM,WORK SIZA               REST OF LAST BUFF & STORE IT       LIO
         B        GETBUFF           GO GET NEXT PAGE IF NEEDED EL31774  LIO
         B        GETBUFF
SET%ADRS EQU      %
         LW,BUFF  NEXT%BUF          GET BUFFER ADDRESS
         AWM,SIZE NEXT%BUF          SET NEXT BUFFER ADDRESS
         LCW,WORK SIZE              DECREMENT
         AWM,WORK SIZA               AVAILABLE SPACE
         B        *LNK2%HLD         ** EXIT **
NO%ROOM  EQU      %
         LI,ERROR NO%BUF                                                C:LIO

ERRCOM   RES      0                                                     C:LIO
         AI,ERROR -X'20'            CONVERT A TO 8                      C:LIO
         LW,SR3   DCB                                                   C:LIO

         STB,ERROR SR3                                                  C:LIO

         B        ABORT                                                 C:LIO

ZRO      EQU      %
         LI,ODD   X'E0000'
         LI,EVEN  0
         STS,EVEN CUR%SIZE,FIST
         STS,EVEN CUR%DISP,FIST
         STW,EVEN 3,FIST                                                C:LIO *
         B        *LNK2
HLNK2    RES      1                                                     C:LIO *
CHKVAR   RES      0                                                     C:LIO
         STW,LNK2 HLNK2                                                 C:LIO
         LW,LNK2  STATUS,FIST                                           C:LIO
         SLS,LNK2 -23                                                   C:LIO
         CI,LNK2  1                                                     C:LIO
         BAZ      *HLNK2                                                C:LIO
         MTW,1    HLNK2                                                 C:LIO
         B        *HLNK2                                                C:LIO
C:ALLC   LW,WORK  CBUF%ADR,FIST     GET BUFFER ADDRESS                  LIO
         BEZ      ALLCOM            IF NOT ALLOCATE, GO TO ALLOC        LIO
         B        *LINK                                       EL30274   LIO
         PAGE
* CLOSE PROCESSING
C:CLS    EQU      %
         LCI      0                                                     C:LIO

         STM,0    SAVEM             SAVE THE REGISTERS                  C:LIO

         MTB,1    FIST              SET OPEN/CLOSE FLAG                 C:LIO

         BAL,LNK2 CHK%LOCK          CHECK FOR FILE LOCKED               C:LIO

         LW,DCB   DCB%ADR,FIST      PICK UP DCB ADDRESS
         LI,STATS 2                 IF NOT OPEN
         CW,STATS STATUS,FIST        OUTPUT
         BAZ      CHK%RWD          GO TO REWIND THE FILE
         MTH,2    FIST              SET OUTPUT FLAG
         BAL,LINK C:WOB             WRITE LAST BLOCK
         LW,LINK  SAVEM+LINK                                            C:LIO *
CHK%RWD  EQU      %
         CI,OPTN  CLS%REEL
         BE       C:CVOL%2
         LI,ODD   X'90'                                                 LIO
         LI,EVEN  0
           STS,EVEN CLOSE+1
         CI,OPTN  NO%RWD%CLS                                  EL30474   LIO
         BANZ     CLS%OUT           JUMP IF NO REWIND         EL30474   LIO
         LI,INDX1 DCB%COS                                     EL30474   LIO
         LB,WORK  *DCB,INDX1        GET CURRENT SN            EL30474   LIO
         CI,WORK  2                 IF CURRENT SN < 2,        EL30474   LIO
         BL       CLS%OUT             JUMP,  ELSE             EL30474   LIO
CLS%LOCK LI,ODD   X'20'             CLOSE WITH LOCK            EL30874  LIO
         STS,ODD  CLOSE+1           .. SO SET REM OPTION       EL30874  LIO
         CAL1,1   CLOSE             .. CLOSE                   EL30874  LIO
         LI,EVEN  0                                            EL30874  LIO
         STS,EVEN CLOSE+1           ... RESET REM OPTION       EL30874  LIO
         B        CLS%DONE          GO BACK                    EL30874  LIO
RWD%DONE EQU      %
         LH,WORK  *DCB              UNLESS
         CI,WORK  X'20'               ALREADY CLOSED
         BAZ      CLS%DONE
         CI,OPTN  LOCKED
         BANZ     CLS%LOCK                   LOCK IF NEEDED
         CI,OPTN  DELETE            CLOSE WITH RELEASE ?                LIO
         BAZ      CLS%IT            NO, GO TO CLOSE                     LIO
         MTW,-1   CLOSE+2           SET RELEASE FLAG = 1 (2 - 1)        LIO
         CAL1,1   CLOSE             CLOSE WITH RELEASE                  LIO
         MTW,1    CLOSE+2           SET BACK SAVE FLAG = 2              LIO
         B        CLS%DONE          GO TO EXIT                          LIO
CLS%IT   EQU      %
         CAL1,1   CLOSE             CLOSE
CLS%DONE EQU      %
         LI,INDX1 3                                                     C:LIO

         STH,OPTN *FIST,INDX1                                           C:LIO

         B        *LINK             *** EXIT ***
CLS%OUT  EQU      %
         LI,ODD   3                 GET
         LS,ODD   *DCB              .ASN
         CI,ODD   2
         BL       RWD%DONE          IF FILE...GO CLOSE
         BG       CLS%DEV           IF DEVICE GO WEOF
CLS%LBL  EQU      %
         CI,OPTN  LOCKED            IF LOCKED
         BANZ     RWD%DONE          GO CLOSE (REM WILL REWIND)
         CI,OPTN  NO%RWD%CLS
         BANZ     CLS%IT
         LI,ODD   X'90'             PTL OPTION AND PTV OPTION FOR ANS
         STS,ODD  CLOSE+1
         B        CLS%IT
CLS%DEV  EQU      %
         NOP
         CI,OPTN  NO%RWD%CLS
         BANZ     RWD%DONE
         CAL1,1   WEOF                                                  C:LIO
         CAL1,1   WEOF                                                  C:LIO
         CAL1,1   PRECORD%REV                                           C:LIO
         CI,OPTN  LOCKED            IF LOCKED OPTION ON        EL30874  LIO
         BANZ     CLS%LOCK          GO CLOSE WITH REMOVE       EL30874  LIO
         CAL1,1   REWIND            REWIND THE TAPE            EL30874  LIO
         CAL1,1   CLOSE
         CAL1,1   NULL%CHK          CLEAR EOD
         B        CLS%DONE          GO BACK TO CLOSE                    C:LIO
C:CVOL2  EQU      %
C:CVOL%2  EQU      %
         CI,FIST  OUTPUT            IF CVOL
         BANZ     C:CVOL%4
         LI,INDX1 4*STATUS          ON INPUT
         LB,WORK  *FIST,INDX1
         STB,WORK *FIST             SET FIST
         BAL,LNK2 ZRO               ZERO CURRENT SIZE AND DISPLACEMENT
C:CVOL%3 EQU      %
         CAL1,1   CVOL
         B        *LINK
C:CVOL%4 EQU      %
         LI,ODD   3                                                     C:LIO

         LS,ODD   *DCB                                                  C:LIO

         CI,ODD   2                                                     C:LIO

         BLE      C:CVOL%3                                              C:LIO

         CAL1,1   WEOF              DOUBLE
         CAL1,1   WEOF                EOF
         CAL1,1   PRECORD%REV
         B        C:CVOL%3          THEN CVOL
         PAGE
* READ PROCESSING
C:RLR    EQU      %
C:WLR    EQU      %
         LCI      0
         STM,0    SAVEM
         BAL,LNK2 CHK%LOCK          CHECK FOR FILE LOCKED               C:LIO

         LW,DCB   DCB%ADR,FIST      PICK UP DCB ADDRESS
VAREENT  RES      0                                                     C:LIO
         LW,DISP  CBUF%ADR,FIST     CHECK FOR UNBLOCKED I/O
         BNEZ     BLOKT              OR BLOCKED I/O
*    U N B L O C K E D
BLOK0    EQU      %
         LW,RECD  REC%ADR,FIST      GET RECORD ADDRESS INTO RECD
         CI,FIST  OUTPUT            IS THIS A WRITE
         BANZ     BLOK0%2            YES GO DO IT
         LI,ODD   KEYD%DIR
         CS,ODD   5,DCB
         BNE      BLOK0%1
         BAL,LNK2 SETKAD            GO SET UP KAD                       C:LIO

         CAL1,1   READ%KEY
         B        BLOK0%4
BLOK0%1  EQU      %
         BAL,LNK2 SET%DRTN          SET THE DIRECTION OF READING
         CAL1,1   READ              READ IT
         BAL,LNK2 CHECKER                                               C:LIO
         B        RESTOREM
BLOK0%2  EQU      %
         LI,ODD   KEYD%DIR
         CS,ODD   5,DCB
         BNE      BLOK0%3
         BAL,LNK2 SETKAD            GO SET UP KAD                       C:LIO

         LI,ODD   X'60'             NEWKEY, ONEWKEY OPTIONS             C:LIO *
         LI,EVEN  X'60'                                                 C:LIO *
         CI,STATS 2                 OPEN OUTPUT                         C:LIO *
         BAZ      %+2               NO. GO SET BOTH OPTIONS             C:LIO *
         AI,EVEN  -X'40'            YES. SET NEWKEY ONLY                C:LIO *
         STS,EVEN WRITKEY+1                                             C:LIO *
         CAL1,1   WRITKEY
         B        BLOK0%4
BLOK0%3  EQU      %
         BAL,LNK2 WRIYT                                                 C:LIO

         CAL1,1   WRITE
BLOK0%4  EQU      %
         BAL,LNK2 CHECKER                                               C:LIO
         B        RESTOREM
SETKAD   LW,WORK  REC%ADR,FIST      KEY ADDRESS IS                      C:LIO

         AI,WORK  X'60000'           SIZE OF RECORD AREA                C:LIO

         SLS,WORK -19                (IN WORDS)                         C:LIO

         AW,WORK  REC%ADR,FIST       PLUS RECORD AREA ADDRESS           C:LIO

         AND,WORK =X'1FFFF'                                             C:LIO

         STW,WORK KAD                                                   C:LIO

         LB,WORK  DCB               GET SAVED KEYM                      C:LIO
         STB,WORK *KAD              PUT IT INTO FPT                     C:LIO
         B        *LNK2                                                 C:LIO

         PAGE
*    B L O C K E D
BLOKT    EQU      %
         AND,DISP =X'FFFE0000'      IF CURRENT DISPLACEMENT ZERO
         BNEZ     BLOKT%1           ..
         CI,DCB   X'20000'          RELATIVE FILE                       C:LIO *
         BANZ     RELATIVE          GO TAKE CARE OF IT                  C:LIO *
* NO CURRENT BLOCK AVAILABLE
         LW,EVEN  CUR%SIZE,FIST      IF CURRENT BLOCK SIZE
         AND,EVEN  =X'FFFE0000'        NON-0E-O
         BNEZ     BLOKT%1              BLOCJ HAS BEEN CHECKED
IF%PRIMD EQU      %
         LB,WORK  *FIST             IF BUFFERS PRIMED (OR WRITE)
         BEZ      BLOK%CHK           GO TO CHECK THIS BLOCK I/O
         CI,FIST  OUTPUT            IF OUTPUT
         BAZ      PRIME%1
         MTB,-1   *FIST             DO NOT WRITE
         B        BLOKT%OT            JUST FILL BUFFER
PRIME%1  EQU      %
*PRIME THE BUFFER(S)
         LW,TO    =X'FFFE0000'
         BAL,LNK2 BLOKT%41          READ A BUFFER FULL..OR SO..
         LI,DISP  0                                                     C:LIO

         MTB,-1   *FIST             IF ONLY 1 BUFFER TO
         BEZ      BLOK%CHK           PRIME, GO CHECK IT
         BAL,LNK2 BLOKT%41          START NEXT READ
         LI,DISP  0
         STB,DISP *FIST
         B        BLOKT%1           START DEBLOCKING
BLOK%CHK EQU      %
         LW,STATS STATUS,FIST
         CI,STATS ENDED
         BAZ      %+4
         LW,SR3   0,FIST
         MTB,6    SR3
         B        ABN%EXIT
         BAL,LNK2 CHECKER                                               C:LIO
         CI,FIST  OUTPUT
         LI,ODD   X'E0000'
         BANZ     BLOKT%OT
         LS,EVEN  4,DCB             GET ARS FROM DCB
         BNEZ     BLOK%SZ
BLOKT%OT EQU      %
         LW,EVEN  3,DCB              USE RSZ FOR WRITE (OR  ARS = ZERO)
BLOK%SZ  EQU      %
         LW,ODD   =X'FFFE0000'       FROM DCB
         STS,EVEN CUR%SIZE,FIST     USE AS CURRENT SIZE
* BLOCK AVAILABLE
BLOKT%1  EQU      %
         SLS,DISP -17               JISTIFY AND STORE
         STH,DISP DISPLACE            DISPLACEMENT
         LW,FROM  CBUF%ADR,FIST     CURRENT BUFFER
         AND,FROM =X'1FFFF'             IS FROM ADDRESS
         LW,TO    REC%ADR,FIST       LOGICAL RECORD
         AND,TO   =X'1FFFF'             IS TO ADDRESS
         SLD,FROM 2                 BOTH ADDRESSES TO BYTES
         LI,WORK  REVERSED
         CW,WORK  STATUS,FIST
         BAZ      NOT%REV           GO ON
         LI,ODD   3
         LS,ODD   *DCB
         CI,ODD   1
         BNE      %+3
         LW,WORK  4,DCB
         B        %+2
         LW,WORK  3,DCB             ELSE
         SLS,WORK -1                ADD
         AH,FROM  WORK              RSZ TO FROM ADDRESS
         SH,FROM  DISPLACE          SUBTRACT DISPLACEMENT FROM FROM
         LW,SIZE  MAX%SIZE,FIST
         AND,SIZE =X'FFFE0000'
         AWM,SIZE CUR%DISP,FIST     ADD SIZE TO DISPLACEMENT
         SLS,SIZE -17               SET SIZE FOR MOVE
         SW,FROM  SIZE              SUBTRACT SIZE FROM FROM ADDRESS
         B        BLOKT%3           GO MOVE A RECORD
NOT%REV  EQU      %
         AH,FROM  DISPLACE          ADD DISPLACEMENT TO FROM
* MOVE THE RECORD
BLOKT%2  EQU      %
         STW,SIZE SIZAA                                                 C:LIO *
         BAL,LNK2 CHKVAR                                                C:LIO
         B        BLKT2V10                                              C:LIO
         CI,FIST  OUTPUT                                                C:LIO
         BAZ      BLOKT%3                                               C:LIO
         LW,SIZE  SAVEM+SIZE                                            C:LIO
         SLS,SIZE 17                                                    C:LIO
         B        BLKT2V10+2                                            C:LIO
BLKT2V10 RES      0                                                     C:LIO
         LW,SIZE  MAX%SIZE,FIST     ADD LOGICAL RECORD SIZE
         AND,SIZE =X'FFFE0000'
         AWM,SIZE CUR%DISP,FIST           TO DISPLACEMENY
         CW,SIZE  CUR%SIZE,FIST                                         C:LIO
         BL       SLS%SIZE                                              LIO
         LW,SIZE  CUR%SIZE,FIST                                         C:LIO
         BGZ      SLS%SIZE                                              LIO
         LW,SIZE  MAX%SIZE,FIST                                         LIO
SLS%SIZE RES      0                                                     LIO
         SLS,SIZE -17               JUSTIFY SIZE
         CI,FIST  OUTPUT                                                C:LIO *
         BAZ      BLOKT%3                                               C:LIO *
         XW,FROM  TO                                                    C:LIO *
         BAL,LNK2 CHKVAR            CHECK VAR LNGTH RCD        EL31774  LIO
         B        DJ%%2             JUMP IF NOT A VAR RCD      EL31774  LIO
         LW,ODD   =X'FFFE0000'                                 EL31674  LIO
         LW,EVEN  CUR%DISP,FIST     GET ACTUAL SIZE            EL31674  LIO
         CS,EVEN  CUR%SIZE,FIST     IF ACTUAL SIZE > BUFF SIZE EL31674  LIO
         BGE      DJ%%15              MOVE CUR RCD TO NEXT BUF EL31674  LIO
         LW,DISP  TO                                                    C:LIO *
DJ%%     RES      0                                                     C:LIO *
         CI,SIZE  255                                                   C:LIO *
         BLE      DJ%%1                                                 C:LIO *
         LI,INDX1 255                                                   C:LIO *
         STB,INDX1 DISP                                                 C:LIO *
         MBS,0    BA(SIZAA)                                             C:LIO *
         AI,SIZE  -255                                                  C:LIO *
         B        DJ%%                                                  C:LIO *
DJ%%1    RES      0                                                     C:LIO *
         STB,SIZE DISP                                                  C:LIO *
         MBS,0    BA(SIZAA)                                             C:LIO *
DJ%%15   RES      0                                            EL31674  LIO
         LW,SIZE  SIZAA             RESTORE ORIGINAL SIZE               C:LIO
         BAL,LNK2 CHKVAR                                                C:LIO
         B        DJ%%2             NOT VARIABLE                        C:LIO
         B        BLKT3V00                                              C:LIO
DJ%%2    RES      0                                                     C:LIO *
         CI,FIST  OUTPUT            IF OUTPUT                           C:LIO

         BAZ      BLOKT%3           NO. GO MOVE                         C:LIO

         CW,SIZE  SAVEM+SIZE        YES.. IF REQUESTED SIZE < MAX SIZE  C:LIO

         BLE      BLOKT%3           NO. GO MOVE                         C:LIO

SHORTBLK RES      0
         LI,WORK  NOISE                                                 C:LUO
         CW,WORK  SAVEM+SIZE                                            C:LIO
         BG       BLKNOISE
         LI,ODD   X'E0000'
         LS,EVEN  MAX%SIZE,FIST
         CS,EVEN  CUR%DISP,FIST
         BEZ      NO%OLD
         LCW,EVEN EVEN
         AWM,EVEN CUR%DISP,FIST
         BAL,LINK C:WOB             YES..WRITE IT OUT
NO%OLD   RES      0
         LI,WORK  0                 PREVENT RECURRENCES
         STW,WORK CBUF%ADR,FIST       OF SITUATION
         STW,WORK ABUF%ADR,FIST
         STB,WORK *FIST
         LI,INDX1 4
         STB,WORK *FIST,INDX1
         LW,SIZE  SAVEM+SIZE                                            C:LIO
         B        BLOK0                                                 C:LIO
BLKNOISE RES      0
         LI,WORK  133               YES.                                C:LIO

         CI,SIZE  133               IF MAX SIZE < 133                   C:LIO

         BGE      %+2               NO . USE 133                        C:LIO

         LW,WORK  SIZE              YES.. USE MAX SIZE                  C:LIO

         STB,WORK TO                                                    C:LIO

         LW,WORK  TO                                                    C:LIO

         MBS,0    BA(=X'1FFFF')     MOVE HEX 00 TO NEXT RECORD          C:LIO

        LW,SIZE    SAVEM+SIZE      MOVE REQUESTED SIZE                  C:LIO

BLOKT%3  EQU      %
         BAL,LNK2 CHKVAR                                                C:LIO
         B        BLKT3V50                                              C:LIO
BLKT3V00 RES      0                                                     C:LIO
         LW,RECD  CBUF%ADR,FIST                                         C:LIO
         LW,LNK2  =X'80000'         TO ADD 4 TO CUR%DISP                C:LIO
         MTH,0    DISPLACE                                              C:LIO
         BNEZ     BLKT3V10                                              C:LIO
         AWM,LNK2 CUR%DISP,FIST     FOR BLKPREF                         C:LIO
         CI,FIST  OUTPUT                                                C:LIO
         BAZ      BLKT3V60                                              C:LIO
         LI,FROM  BA(=X'4')         INITIALIZE BLKPREF                  C:LIO
         MTB,4    TO                                                    C:LIO
         MBS,FROM 0                                                     C:LIO
BLKT3V10 RES      0                                                     C:LIO
         CI,FIST  OUTPUT                                                C:LIO
         BAZ      BLKT3V70                                              C:LIO
         AWM,LNK2 CUR%DISP,FIST     FOR RECPREF                         C:LIO
* SEE IF REC AND RECPREF FIT                                            C:LIO
         LW,ODD   =X'FFFE0000'                                          C:LIO
         LW,EVEN  CUR%DISP,FIST                                         C:LIO
         CS,EVEN  CUR%SIZE,FIST                                         C:LIO
         BLE      BLKT3V30          IT FITS                             C:LIO
         MTH,0    DISPLACE                                              C:LIO
         BNEZ     BLKT3V20                                              C:LIO
         LI,ERROR X'A9'             LOGICAL RECORD TOO LARGE            C:LIO
         B        ERRCOM                                                C:LIO
BLKT3V20 RES      0                                                     C:LIO
         LW,TO    =X'FFFE0000'                                          C:LIO
         BAL,LNK2 BLOKT%41          GO TO WRITE A BLOCK        EL31674  LIO
         LW,SIZE  SAVEM+SIZE        GET CURRENT REC SIZE       EL31674  LIO
         B        VAREENT           TO PROCESS CURRENT RCD     EL31674  LIO
* STORE RECPREF AND RECORD                                              C:LIO
BLKT3V30 RES      0                                                     C:LIO
         LW,WORK  SAVEM+SIZE        BUMP BY SIZE + 4                    C:LIO
         AI,WORK  4                                                     C:LIO
         AWM,WORK *RECD                                                 C:LIO
         SLS,WORK 16                                                    C:LIO
         LI,FROM  4*WORK                                                C:LIO
         MTB,4    TO                                                    C:LIO
         MBS,FROM 0                                                     C:LIO
         LW,FROM  REC%ADR,FIST                                          C:LIO
         SLS,FROM 2                                                     C:LIO
BLKT3V50 RES      0                                                     C:LIO
         CI,DCB   X'40000'          RANDOM                              C:LIO *
         BAZ      BLOKT%31                                              C:LIO *
         LB,WORK  0,FROM            YES.                                C:LIO *
         CI,WORK  X'FF'             HIGH-VALUE IN BYTE 1                C:LIO *
         BE       ABN%EXIT          END OF FILE                         C:LIO *
BLOKT%31 RES      0                                                     C:LIO *
         CI,SIZE  255               IF MORE THAN
         BLE      BLOKT%4               255 BYTESS
         LI,WORK  255                   TO MOVE,
         STB,WORK TO
         MBS,FROM 0                     MOVE 255
         AI,SIZE  -255                  DECREMENT BY 255
         B        BLKT3V50                                              C:LIO
* READ VARLEN REC                                                       C:LIO
BLKT3V60 RES      0                                                     C:LIO
         LW,SIZE  CUR%SIZE,FIST                                         C:LIO
         SLS,SIZE -17                                                   C:LIO
         CH,SIZE  *RECD                                                 C:LIO
         BE       BLKT3V62                                              C:LIO
         LI,ERROR X'A8'                                                 C:LIO
         B        ERRCOM                                                C:LIO
BLKT3V62 RES      0                                                     C:LIO
         MTH,-4   *RECD             DECR BLKPREF                        C:LIO
         AI,FROM  4                                                     C:LIO
BLKT3V70 RES      0                                                     C:LIO
         LB,SIZE  0,FROM                                                C:LIO
         SLS,SIZE 8                                                     C:LIO
         AI,FROM  1                                                     C:LIO
         LB,WORK  0,FROM                                                C:LIO
         OR,SIZE  WORK                                                  C:LIO
         AI,FROM  3                                                     C:LIO
         SLS,SIZE 17                                                    C:LIO
         AWM,SIZE CUR%DISP,FIST                                         C:LIO
         LW,WORK  *RECD                                                 C:LIO
         SLS,SIZE -1                                                    C:LIO
         SW,WORK  SIZE                                                  C:LIO
         STW,WORK *RECD                                                 C:LIO
         BGEZ     BLKT3V80                                              C:LIO
         LI,ERROR X'A7'                                                 C:LIO
         B        ERRCOM                                                C:LIO
BLKT3V80 RES      0                                                     C:LIO
         SLS,SIZE -16                                                   C:LIO
         AI,SIZE  -4                                                    C:LIO
         LW,WORK  MAX%SIZE,FIST                                         C:LIO
         SLS,WORK -17                                                   C:LIO
         CW,WORK  SIZE                                                  C:LIO
         BGE      BLKT3V50                                              C:LIO
         LI,ERROR X'A6'                                                 C:LIO
         B        ERRCOM                                                C:LIO
BLOKT%4  EQU      %
         STB,SIZE TO                 ELSE
         MBS,FROM 0                     MOVE BYTES LESS THAN 256
* MOVE DONE
         LW,TO    =X'FFFE0000'      CHECK IF
         LW,FROM  CUR%DISP,FIST         THE MOVE
         CS,FROM   CUR%SIZE,FIST         HAS EXHAUSTED THE BUFFER
         BL        RESTOREM
         LI,LNK2  RESTOREM
* SET UP FPT FOR READ/WRITE
BLOKT%41 EQU      %
         STW,LNK2 LNK2%HLD                                              C:LIO

         LW,RECD  CBUF%ADR,FIST     PICK UP BUFFER ADDRESS
         LS,FROM  CUR%SIZE,FIST         AND
         SLS,FROM -17               RECORD SIZE
         STS,FROM CUR%DISP,FIST     ZERO OUT DISPLACEMENT
         STS,FROM CUR%SIZE,FIST         AND BUFFER SIZE IN FILE INFO
         LW,SIZE  FROM
         LW,WORK  ABUF%ADR,FIST     EXCHANGE ALTERNATE
         XW,WORK   CBUF%ADR,FIST        AND
         STW,WORK ABUF%ADR,FIST     CURRENT BUFFER ADDRESSES
         CW,WORK  CBUF%ADR,FIST     IF BOTH BUFFERS
         BE       CHK%LATR              SAME ADDRESS CHECK LATER
         BAL,LNK2 CHECKER                                               C:LIO
         LW,ODD   =X'FFFE0000'
         CI,FIST  OUTPUT
         BANZ     %+3
         LW,EVEN  4,DCB             PICK UP ARS
         B        %+2
         LW,EVEN  3,DCB                (OR RSZ , IF OUTPUT)
         STS,EVEN CUR%SIZE,FIST      AS CURRENT SIZE
CHK%LATR EQU      %
         CI,FIST  OUTPUT            IF
         BANZ     BLOKT%5
         BAL,LNK2 SET%DRTN          SET THE DIRECTION OF READING
         CAL1,1   READ              START READ OF NEXT BLOCK
         B        *LNK2%HLD
BLOKT%5  EQU      %
         BAL,LNK2 CHKVAR                                                C:LIO
         B        BLKT5V10                                              C:LIO
         LW,SIZE  *RECD                                                 C:LIO
         SLS,SIZE 16                                                    C:LIO
         STW,SIZE *RECD                                                 C:LIO
         SLS,SIZE -16                                                   C:LIO
BLKT5V10 RES      0                                                     C:LIO
         BAL,LNK2 WRIYT                                                 C:LIO

         CAL1,1   WRITE             START WRITE OF NEXT BLOCK
          B        *LNK2%HLD                                            C:LIO

*                                                                       C:LIO *
*    RELATIVE FILE ACCESS METHOD                                        C:LIO *
RELATIVE RES      0                                                     C:LIO *
         STW,15   KEYSV                                                 C:LIO *
         LW,WORK  BLOCKSZ,FIST                                          C:LIO *
         AND,WORK =X'FFFF'                                              C:LIO *
         STW,WORK BLOK%CNT                                              C:LIO *
         LI,KEY   0                 GET BLOK NR IN BLOKK                C:LIO *
         DW,KEY   BLOK%CNT               AND REC NR IN RDISP            C:LIO *
         LW,WORK  LAST%BLK,FIST                                         C:LIO *
         AND,WORK =X'FFFFFF'        IF BLK NOT SAME AS                  C:LIO *
         CW,BLOKK WORK               LAST I/O                           C:LIO *
         BNE      REL%CHNG          GO CHANGE BLOCKS                    C:LIO *
REL%OLD  LW,FROM  CBUF%ADR,FIST     SAME BLOCK IN CORE         EL35274  LIO
         LW,TO    REC%ADR,FIST                                          C:LIO *
         AND,TO   =X'1FFFF'                                             C:LIO *
         SLD,FROM 2                 SET UP                              C:LIO *
         LW,SIZE  MAX%SIZE,FIST                                         C:LIO *
         AND,SIZE =X'FFFE0000'                                          C:LIO *
         SLS,SIZE -1                                                    C:LIO *
         MH,RDISP SIZE                                                  C:LIO *
         AW,FROM  RDISP+1                REGS FOR MBS                   C:LIO *
         CI,FIST  OUTPUT            OUTPUT                              C:LIO *
         BAZ      REL%01                                                C:LIO *
         LW,ODD   =X'11000000'      SET FLAG IN INDEX AREA              C:LIO *
         STS,ODD  LAST%BLK,FIST                                         C:LIO *
         XW,FROM  TO                SWITCH FROM & TO                    C:LIO *
REL%01   LB,WORK  0,FROM                                                C:LIO *
         CI,WORK  X'FF'             X'FF' = A NON-RECORD                C:LIO *
         BE       ABN%REL               GIVE INVALID KEY                C:LIO *
REL%011  RES      0                                                     C:LIO *
         LW,SIZE  MAX%SIZE,FIST                                         C:LIO *
         SLS,SIZE -17                                                   C:LIO *
REL%02   RES      0                                                     C:LIO *
         MTB,-1   TO                                                    C:LIO *
         CI,SIZE  255                                                   C:LIO *
         BG       REL%03                                                C:LIO *
         STB,SIZE TO                                                    C:LIO *
REL%03   RES      0                                                     C:LIO *
         MBS,FROM 0                 MOVE RECORD                         C:LIO *
         AI,SIZE  -255                                                  C:LIO *
         BLEZ     RESTOREM                                              C:LIO *
         B        REL%02                                                C:LIO *
ABN%REL RES      0                                                      C:LIO *
        CI,FIST  OUTPUT       IF OUTPUT                                 C:LIO *
         BANZ     REL%011       HE'S DELETING...DO IT                   C:LIO *
         B        ABN%EXIT       ELSE TELL ABOUT IT                     C:LIO *
*                                                                       C:LIO *
*    CODE TO CHANGE TO THE REQUIRED RELATIVE BLOCK                      C:LIO *
REL%CHNG RES      0                                                     C:LIO *
         LW,WORK  BLOKK                                                 C:LIO *
         LI,ODD   X'91'             SET REWRITE OF THIS BLOCK           C:LIO *
         STB,ODD  RANDIO                                                C:LIO *
         XW,WORK  LAST%BLK,FIST     UPDATE LAST BLOCK ACCESSED          C:LIO *
         LW,SIZE  BLOCKSZ,FIST                                          C:LIO *
         SLS,SIZE -16                                                   C:LIO *
         LW,RECD  CBUF%ADR,FIST                                         C:LIO *
         LW,EVEN  HIGH%BLK,FIST     ARE WE IN CREAT MODE ?     EL35274  LIO
         BLZ      REL%WRT           YES, ALWAYS TO WRITE       EL35274  LIO
         LB,ODD   WORK              WAS BLK IN CORE WRITTEN INTO        C:LIO *
         BEZ      REL%C%00          NO. GO READ                         C:LIO *
REL%WRT  AND,WORK =X'FFFFFF'                                   EL35274  LIO
REL%C%W  CAL1,1   RANDIO            WRITE BLOCK                         C:LIO *
         LW,EVEN  HIGH%BLK,FIST     ARE WE IN CREATE MODE               C:LIO *
         BLZ      REL%NEW           YES. GO  CHECK                      C:LIO *
REL%C%00 LW,WORK  LAST%BLK,FIST     SET TO READ BLOCK                   C:LIO *
         MTB,-1   RANDIO            SET CAL TO READ                     C:LIO *
         CAL1,1   RANDIO                                                C:LIO *
         LW,15   KEYSV                                                  C:LIO *
         B        REL%OLD           GO BACK TO DEBLOCK                  C:LIO *
*                                                                       C:LIO *
*    SPECIAL CODE FOR 'NEW' RANDOM FILES                                C:LIO *
*                                                                       C:LIO *
REL%NEW  LI,ODD   X'FF'             TO SET NULL RECORD         EL35274  LIO
         LW,SIZE  MAX%SIZE,FIST     YES.                                C:LIO *
         SLS,SIZE -17                                                   C:LIO *
         LW,INDX1 BLOCKSZ,FIST                                          C:LIO *
         LH,INDX1 INDX1                                                 C:LIO *
REL%N%01 RES      0                                                     C:LIO *
         SW,INDX1 SIZE                                                  C:LIO *
         BLZ      REL%N%10                                              C:LIO *
         STB,ODD  *RECD,INDX1       STORE NULL-REC IN ALL BLOCK         C:LIO *
         B        REL%N%01                                              C:LIO *
REL%N%10 RES      0                                                     C:LIO *
         MTW,1    HIGH%BLK,FIST     UPDATE HIGHEST BLOCK                C:LIO *
         LW,WORK  HIGH%BLK,FIST                                         C:LIO *
         AND,WORK =X'FFFFFF'                                            C:LIO *
         CW,WORK  LAST%BLK,FIST     IS NULL BLK REACH CURRENT RCD ?     LIO
         BG       REL%OLD           JUMP IF YES                EL35274  LIO
         LW,SIZE  BLOCKSZ,FIST                                          C:LIO *
         LH,SIZE  SIZE                                                  C:LIO *
         B        REL%C%W           GO WRITE THIS BLOCK                 C:LIO *
* SET THE DIRECTION FVOR READING
SET%DRTN EQU      %
         CI,DCB   X'40000'                                              C:LIO *
         BANZ     RANDORG                                               C:LIO *
         LW,WORK  READ%FWD          INITIALIZE TO FORWARD
         LI,STATS REVERSED          IF CURRENT
         CW,STATS STATUS,FIST        STATUS IS REVERSED
         BAZ      SET%IT
         AI,WORK  FLAG2              SET REVERSED
SET%IT   EQU      %
         CW,DCB   =X'80000'         USER LABELS                         C:LIO
         BANZ     %+2               YES. LEAVE ULBL SET                 C:LIO
         AI,WORK  -8                NO. TURN OFF ULBL                   C:LIO
         STW,WORK READ%FLG          STORE IN FPT
         B        *LNK2              ** EXIT **
RESTOREM EQU      %
         LCI      0
         LM,0     SAVEM
         B        *LINK
         PAGE
C:WOB    EQU      %
         LW,FROM  CUR%DISP,FIST
C:CIB    EQU      %
         LW,TO    =X'FFFE0000'      MOVE CURRENT SIZE OF BLK
         CI,DCB   X'40000'          RANDOM                              C:LIO *
         BAZ      WB                NO. GO ON                           C:LIO *
         CI,DCB   X'20000'                                              C:LIO *
          BANZ     CLS%REL                                              C:LIO *
         CS,FROM  CUR%SIZE,FIST     BLOCK FULL                          C:LIO *
         BE       ONE%XTRA          YES. TAKE CARE OF IT                C:LIO *
         SLS,FROM -17                                                   C:LIO *
         AW,FROM  CBUF%ADR,FIST                                         C:LIO *
LASTWRT  AND,FROM =X'1FFFF'                                             C:LIO *
         SLS,FROM 2                                                     C:LIO *
         LI,TO    X'FF'                                                 C:LIO *
         STB,TO   0,FROM                                                C:LIO *
         LW,LNK2  LINK                                                  C:LIO *
         B        RANDORG                                               C:LIO *
CLS%REL  RES      0                                                     C:LIO *
         LI,WORK  2                                             EL34474 LIO
         CW,WORK  STATUS,FIST       CHECK FOR OUTPUT            EL34474 LIO
         BANZ     CLS%REL1          YES..FILL FILE                      C:LIO *
         LW,WORK  =X'00FFFFFF'                                          C:LIO *
         STW,WORK 5,FIST            NO..SET IMPOSSIBLE BLOCK            C:LIO *
         B        *LINK                                                 C:LIO *
CLS%REL1 RES      0                                                     C:LIO %
         LI,15    -1                                                    C:LIO *
         LI,WORK  0                                                     C:LIO *
         STW,WORK SAVEM+SIZE        SET TO DO NULL MOVE                 C:LIO *
         LW,WORK  CLS%RANX          WRITE LAST BLOK                     C:LIO *
         XW,WORK  C:ABA                 *                               C:LIO *
         STW,WORK CLS%RANX              *                               C:LIO *
         B        RELATIVE                                     EL35274  LIO
CLS%RANX B        %+1                   *                               C:LIO *
         LW,WORK  CLS%RANX              *                               C:LIO *
         XW,WORK  C:ABA                 *                               C:LIO *
         STW,WORK CLS%RANX              *                               C:LIO *
         B        *LINK             GET OUT                             C:LIO *
ONE%XTRA RES      0                                                     C:LIO *
         BAL,LNK2 RANDORG           WRITE NEXT-TO-LAST BLOCK            C:LIO *
         LW,FROM  20,DCB                                                C:LIO *
         AND,FROM =X'FFFF'                                              C:LIO *
         CW,FROM  3,FIST                                                C:LIO *
         BE       *LINK                                                 C:LIO *
         B        LASTWRT                                               C:LIO *
WB       RES      0                                                     C:LIO *
         STS,FROM CUR%SIZE,FIST
         LW,DCB   DCB%ADR,FIST
         CS,FROM  =X'1FFFF'                                             C:LIO

         BEZ      WOB%CHK-1            ZERO-LENGTH RECORDS
         CAL1,1   CHECK             CHECK IF PREVIOUS WRITE OK
         BAL,LNK2 BLOKT%41          WRITE THE BLOK
         CAL1,1   CHECK             CHECK THIS WRITE
WOB%CHK  EQU      %
         B        *LINK             *** EXIT ***
*
CHK%LOCK EQU      %      CHECK FOR IF CLOSED WITH LOCK                  C:LIO

         LW,DCB   DCB%ADR,FIST      PICK UP DCB ADDRESS                 C:LIO

         LW,STATS STATUS,FIST       PICK UP STATUS WORD                 C:LIO

         CI,STATS LOCKED            IF LOCKED FILE                      C:LIO

         BAZ      CHK%LCK2          NO...GO CHECK OPEN                  C:LIO *
         LW,SR3   0,FIST            YES. SET DCB ADDRESS                C:LIO

         LI,WORK  LOCK%ERR              AND I/O ERROR                   C:LIO

         STB,WORK SR3                   8F IN SR3 (R10)                 C:LIO

         B        ERROR%XX          GO REPORT ERROR                     C:LIO

CHK%LCK2 RES      0                                                     C:LIO

         LI,WORK  X'20'                                                 C:LIO

         CH,WORK  *DCB              IF FILE OPEN                        C:LIO

         BANZ     *LNK2             YES..GET OUT                        C:LIO

         LB,WORK  FIST              N0. ..IF OPEN/CLOSE                 C:LIO

         BNEZ     *LNK2             YES..GET ON OUT                     C:LIO

         LW,SR3   0,FIST            NO. ERROR TIME                      C:LIO

         LI,WORK  X'80'                                                 C:LIO

         CW,WORK  STATUS,FIST       OPTIONAL FILE                       C:LIO *
         BANZ     *LNK2             YES.                                C:LIO *
         SLS,WORK 24                GET 80 OVER TO LEFT                 C:LIO
         AND,SR3  =X'1FFFF'         SAVE DCB ADDR IF ANY               C:LIO
         OR,SR3   WORK              PUT IN 80 WITH 00 SUBCODE          C:LIO
         B        ERROR%XX                                              C:LIO

RANDORG  RES      0                                                     C:LIO *
         LI,WORK  X'90'                                                 C:LIO *
         STB,WORK RANDIO                                                C:LIO *
         LW,WORK  3,FIST                                                C:LIO *
         CI,FIST  X'20000'                                              C:LIO *
         BAZ      %+2                                                   C:LIO *
         MTB,1    RANDIO                                                C:LIO *
         CAL1,1   RANDIO                                                C:LIO *
         AI,LNK2  1                                                     C:LIO *
         MTW,1    3,FIST                                                C:LIO *
         B        *LNK2                                                 C:LIO *
         PAGE
*
*
*
*
STEPCD   EQU      6                 STEP CODE FOR M:ERR OR M:XXX        LIO
ABNORM   EQU      %
C:ABA    EQU      %
         AND,SR1  =X'1FFFF'
         CLM,SR1  MY%LIMITS
         BCR,9    %+7
         LI,WORK  0
         STB,WORK FIST
         LI,WORK   3
         STW,WORK DISPLACE
         LW,LINK  SR1
         STW,LINK   SAVEM+LINK
         LW,STATS STATUS,FIST
         LB,WORK  SR3
         LI,INDX1 BA(IO%RTNS)-BA(IO%CODES)
CMP%CODE CB,WORK  IO%CODES-0,INDX1
         BE       WHICH
BASE     BDR,INDX1 CMP%CODE
ERROR%XX EQU      %
         CI,STATS DECLARE           IF DECLARATIVES                     C:LIO

         BAZ      ABORT             NO. TELL THE PROGRAMMER             C:LIO

DCL%LNK  EQU      %                                                     C:LIO

         LI,INDX1 1                 SET NON-NORMAL EXIT                 C:LIO

       LI,15 ABORT                                                      C:LIO

        BAL,LINK *LINK,INDX1
ABORT    RES      0                 I/O ABORT PROCESSOR                 C:LIO

* STEP1--PRINT FIRST LINE OF MESSAGE WITH ERROR CODE AND SUB-CODE       C:LIO

         CAL1,1   SPACE1            WRITE A DUMMY LINE
         LI,EVEN  0                                                     C:LIO

         LW,ODD   SR3                                                   C:LIO

         SLD,EVEN 8                                                     C:LIO

         SLS,EVEN 1                                                     C:LIO

         SLD,EVEN -25                                                   C:LIO

         BAL,15   CNVRT                                                 C:LIO

         LW,EVEN  CNVRTRES-1                                            C:LIO

         STW,EVEN ERR%CODE+1                                            C:LIO

         LI,ODD   X'4040'                                               C:LIO

         STH,ODD  ERR%CODE+1                                            C:LIO

         SLS,EVEN -16                                                   C:LIO

         OR,EVEN  =X'40400000'                                          C:LIO

         STW,EVEN ERR%CODE                                              C:LIO

         CAL1,1   DIAGOUT                                               C:LIO

* STEP2--PRINT DCB NAME...                                              C:LIO

         AND,SR3  =X'1FFFF'                                             C:LIO

         BEZ      STEP3                                                 C:LIO

         LI,INDX1 10                                                    C:LIO

         LW,WORK  *0,INDX1                                              C:LIO

STEP210  RES      0                                                     C:LIO *
         STW,WORK DCB%PTR                                               C:LIO

         LW,WORK  *DCB%PTR                                              C:LIO

         STW,WORK DCB%LNK                                               C:LIO

STEP21   RES      0
         AND,DCB  =X'1FFFF'
         MTW,1    DCB%PTR                                               C:LIO

         LB,INDX1 *DCB%PTR                                              C:LIO

         BEZ      STEP20                                                C:LIO *
         SLS,INDX1 -2                                                   C:LIO

         AI,INDX1 1                 ADJUST TO WORD AFTER                C:LIO

         CW,DCB   *DCB%PTR,INDX1                                        C:LIO

         BE       STEP22                                                C:LIO

         AWM,INDX1 DCB%PTR                                              C:LIO *
         B        STEP21                                                C:LIO

STEP20   RES      0                                                     C:LIO *
         LW,WORK  *DCB%LNK                                              C:LIO *
         BEZ      STEP3                                                 C:LIO *
         B        STEP210                                               C:LIO *
STEP22   RES      0                                                     C:LIO

         LB,INDX1 *DCB%PTR                                              C:LIO

         LW,FROM  DCB%PTR                                               C:LIO

         SLS,FROM 2                                                     C:LIO

         AI,FROM  1                                                     C:LIO

         LI,TO    BA(MESSG)                                             C:LIO

         AI,INDX1 -2                FORGET THE F:                       C:LIO

         AI,FROM  2                                                     C:LIO

         STB,INDX1 TO                                                   C:LIO

         MBS,FROM 0                                                     C:LIO

         LI,FROM  BA(DCBMESS)                                           C:LIO

         LI,WORK  11                                                    C:LIO

         STB,WORK TO                                                    C:LIO

         MBS,FROM 0                                                     C:LIO

         LW,WORK  TO                                                    C:LIO

         LI,FROM  BA(ERR%CODE+2)                                        C:LIO

         SW,FROM  TO                                                    C:LIO

         STB,FROM WORK                                                  C:LIO

         MBS,0    BLANKS                                                C:LIO

         CAL1,1   DIAGOUT                                               C:LIO

* STEP3--PRINT RELATIVE LOCATION WITHIN THE USER'S PROGRAM              C:LIO

STEP3    RES      0                                                     C:LIO

         LI,INDX1 2                                                     C:LIO

         LH,WORK  *0,INDX1                                              C:LIO

         AW,WORK  *0                                                    C:LIO

         LW,ODD   LINK                                                  C:LIO

         SW,ODD   WORK                                                  C:LIO

         BGZ      STEP31                                                C:LIO

         AW,ODD   WORK                                                  C:LIO

         LW,WORK  =' ABS'                                               C:LIO

         STW,WORK LOCMESS                                               C:LIO

STEP31   LD,FROM  MBSLOC                                                C:LIO

         MBS,FROM 0                                                     C:LIO

         BAL,15   CNVRT                                                 C:LIO

         LD,EVEN  CNVRTRES-2                                            C:LIO

         STD,EVEN MESSG+LOCN                                            C:LIO

         CAL1,1   DIAGOUT                                               C:LIO

*                                                                       C:LIO

         LCI      0                                                     C:LIO

         LM,0     SAVEM                                                 C:LIO

         LB,WORK  X'2B'             GET SYSTEM DATA            E00775   LIO
         SLS,WORK -4                GET FIRST 4 BITS           EL00775  LIO
         CI,WORK  7                                            EL00775  LIO
         BE       CPVSYS            JUMP IF CPV SYSTEM         EL00775  LIO
         CI,WORK  6                                            EL00775  LIO
         BE       CPVSYS            JUMP IF UTS SYSTEM         EL00775  LIO
         CAL1,9   3                 M:XXX                               C:LIO

CPVSYS   RES      0                                            EL00775  LIO
         M:XXX    STEPCD            SET STEP CODE FOR ABORT 10/8/74     LIO
         CAL1,2   MERC
WAS%56   EQU      %
         LI,ODD   CLOSED            IF DCB
         CW,ODD   STATUS,FIST       NOT CLOSED BY ME
         BNE      *SR1              LET IT BE
         B        ERROR%XX
MERC     DATA     X'10000000'
*
ABN%EXIT EQU      %                                                     C:LIO

         LB,WORK  FIST              IF OPEN OR CLOSE, TREAT AS ERROR    C:LIO

         BNEZ     ERROR%XX                                              C:LIO

         B        DCL%LNK           ELSE, DO NON-NORMAL EXIT            C:LIO

*
ABN%IF%REV EQU %
         MTB,0    FIST                                                  C:LIO

         BNEZ     *SR1                                                  C:LIO

         CI,STATS REVERSED
         BAZ      ERROR%XX
         B        EOF%HERE
*
ABN%IF%IO EQU     ABN%EXIT
ERR%RTN  EQU      C:ERA
*        ANS TAPE - VOLUME SEQUENCE ERROR OR BLOCK COUNT ERROR EL35774  LIO
ANS%BLKCNT LH,WORK SR3              GET ERROR CODE & SUBCODE   EL35774  LIO
         CI,WORK  X'4E0A'                                      EL35774  LIO
         BL       ERROR%XX          JUMP IF VOLUME SEQ ERROR   EL35774  LIO
         LI,ODD   X'800'            ELSE, BLOCK COUNT ERROR    EL35774  LIO
         CW,ODD   *DCB              CHECK ABCERR OPTION        EL35774  LIO
         BAZ      ERROR%XX          JUMP IF ABCERR OFF         EL35774  LIO
         CI,WORK  X'4E0C'           CHECK END TAPE OR END FILE EL35774  LIO
         BGE      DCL%LNK           JUMP IF END OF FILE        EL35774  LIO
*                                   TO EOD%HERE IF END OF TAPE EL35774  LIO
* E O D   H A S   B E E N   R E P O R T E D
EOD%HERE EQU      %
         LI,ODD   3                                                     LIO
         CS,ODD   *DCB              LOOK FOR ASN=3  DEVICE DCB          LIO
         BNE      EOF%HERE          MUST BE END                         LIO
         CI,STATS REVERSED          IGNORE EOD
         BANZ     REREAD
         LI,ODD    7
         LW,WORK  6,DCB
CB       CB,ODD   *WORK
          BE       INSNS
*        CHK HERE FOR END OF VARIABLE PARAMETERS                        LIO
         LI,INDX1 1                                                     LIO
         LB,EVEN  *WORK,INDX1                                           LIO
         CI,EVEN  1                                                     LIO
         BE       EOF%HERE          NO PARAMETERS                       LIO
         LI,INDX1 3
          LB,EVEN *WORK,INDX1
         AI,EVEN   1
         AWM,EVEN WORK
         B        CB
INSNS    LI,INDX1 2
         LB,WORK  *WORK,INDX1
         LI,INDX1 44
         CB,WORK  *DCB,INDX1
         BE       EOF%HERE                                              C:LIO *
         LI,LINK  RESTOREM                                              C:LIO *
         B        C:CVOL%2                                              C:LIO *
REREAD   EQU      %
         CI,LNK2  RESTOREM          IF BLOKT%41 WAS ENTERED FROM
         BE       EOF%HERE            BLOKT%1 WE HAVE READ SOME RECORDS,
         LI,INDX1 4*STATUS
         LB,WORK  *FIST,INDX1
         STB,WORK *FIST
         B        IF%PRIMD
* E O T   H A S   B E E N   R E P O R T E D
EOT%HERE EQU      %
         CI,FIST  OUTPUT            IGNORE EOT
         BANZ     EOT%2                                                 C:LIO

         LI,ODD   3                  ON INPUT                           C:LIO

         CS,ODD   *DCB                                                  C:LIO

         BE       *SR1                  FOR DEVICE                      C:LIO

EOT%2    EQU      %                                                     C:LIO

         AND,SR1  =X'1FFFF'
         CI,SR1   WOB%CHK
         BE       *SR1
         CI,STATS X'40000'          ARE THERE DECLARATIBES              C:LIO

         BAZ      EOT%3             NO.                                 C:LIO

         LI,INDX1 1                 YES.                                C:LIO

         BAL,15   *SAVEM+LINK,INDX1 GO TO PROCESS DECLARATIVES          C:LIO

        STW,LINK SAVEM+LINK                                             C:LIO

EOT%3    EQU      %                                                     C:LIO

         LW,LINK  SR1               ON OUTPUT...
         LW,INDX1 CBUF%ADR,FIST                                         C:LIO

         BNEZ     EOT%4                                                 C:LIO *
         LI,LINK  BLOK0             IF UNBLOKT  CVOL  , RETRY           C:LIO

         B        C:CVOL%2             DO A CVOL AND PROCEED
EOT%4    RES      0                                                     C:LIO *
         LI,ODD   3                                                     C:LIO *
         CS,ODD   *DCB                                                  C:LIO *
         BE       C:CVOL%2                                              C:LIO *
         AI,LINK   -1                                                   C:LIO *
         B        C:CVOL%2                                              C:LIO #
*                                                                       C:LIO #
*      I N V A L I D   K E Y                                            C:LIO #
*                                                                       C:LIO #
INV%KEY  RES      0                                                     C:LIO #
         CI,DCB   X'40000'          RANDOM FILE                         C:LIO #
         BAZ      EOF%HERE          NO..                                C:LIO #
         LW,WORK  =X'00FFFFFF'      YES..FORGET BLOK #                  C:LIO #
         STW,WORK 5,FIST                                                C:LIO #
         B        EOF%HERE          GO REPORT IT                        C:LIO #
* E O F   H A S   B E E N   R E P O R T E D
EOF%HERE EQU      %
         LB,WORK  STATS             IFNOT
         CI,WORK  X'02'               DOUBLE-BUFFERED
         BNE      ABN%EXIT             GO TO EOF RETUR
         LB,WORK  *FIST             IF NOT PRIMING BUFFERS
         BEZ      EOF%2               HANDLE EOF  LATER
         B        ABN%EXIT
EOF%2    EQU      %
         LI,ODD   ENDED             ELSE
         STB,ODD  *FIST
         STS,ODD  STATUS,FIST        SET EOF FLAG FOR LATER
         BAL,LNK2 ZRO               ZERO CURRENT SIZE AND DISPLACEMENT
         B        RESTOREM           THEN GET OUT
*  A   P R O B L E M   W I T H   O P E N
IF%OPTIONAL%OK    EQU %
         CI,OPTN  OPTIONAL          IF OPTIONAL FILE
         BAZ      ERROR%XX
         B        *SR1              ACCEPT THE ERROR
*   P R O B L E M   O P E N I N G   O N   A   R E A D
EOF%IF%OPTIONAL   EQU %
         CI,STATS OPTIONAL          IF OPTIONAL
         BAZ      ERROR%XX
         LI,WORK  X'06'             FOR UN-OPENABLE OPTIONAL FILE       C:LIO

         STB,WORK SR3                 REPORT EOF                        C:LIO

         B        ABN%EXIT          A . O . K .
WHICH    EQU      %
         LB,INDX1 IO%RTNS,INDX1
         B        BASE,INDX1
SORT%ERR,REP%ERR,PROC%ERR RES 0                                         C:LIO
         AND,SR3  =X'FF000000'                                          C:LIO
         B        ABORT                                                 C:LIO
CNVRT    RES      0                                                     C:LIO

         LI,WORK  -8                                                    C:LIO

CNVRT00  RES      0                                                     C:LIO

         LI,EVEN  0                                                     C:LIO

         SLD,EVEN 4                                                     C:LIO

         AI,EVEN  X'F0'                                                 C:LIO

         CI,EVEN  X'F9'                                                 C:LIO

         BLE      CNVRT01                                               C:LIO

         AI,EVEN  -X'39'                                                C:LIO

CNVRT01  RES      0                                                     C:LIO

         STB,EVEN CNVRTRES,WORK                                         C:LIO

         BIR,WORK CNVRT00                                               C:LIO

         B        *15                                                   C:LIO

         BOUND    8                                                     C:LIO

MBSLOC   DATA     BA(LOCMESS),BA(MESSG)+X'28000000'                     C:LIO

         RES      2                                                     C:LIO

CNVRTRES RES      0                                                     C:LIO

BLANKS   TEXT     '    '                                                C:LIO

DCBMESS  TEXT     ' IS FD-NAME'                                         C:LIO

LOCMESS  TEXT     'REL. INST. LOCATION IS    '                          C:LIO

         TEXT     '                    '
LOCN     EQU      7                                                     C:LIO

MY%END   EQU      %
         END
