****************************************************************
*        PROGRAM-ID: KEYIO
*        AUTHOR: CARLTON DEPNER
*        DATE-WRITTEN: JULY, 1972
*                      MODIFICATIONS : FEBRUARY 1974
*                 MODIFIED: FEBRUARY 1979 - FOR FILESCAN
*                           BY RUTH DROZIN &
*                           JON ESCHINGER
*
*        PURPOSE:
*
*        THE PURPOSE OF THIS PROGRAM IS TO PERFORM KEYED
*        FILE OPERATIONS THROUGH A FORTRAN PROGRAM.
*
*        THERE ARE 9 ENTRY POINTS:
*
*        KOPEN - GENERAL FILE OPEN ROUTINE
*        KOPENIN - TO OPEN KEYED FILE IN INPUT MODE
*        KOPENOUT - TO OPEN FILE IN THE OUTPUT MODE
*        KOPENIO - TO OPEN FILE IN THE INPUT-OUTPUT MODE
*        KCLOSES - TO CLOSE AND SAVE A FILE
*        KCLOSER - TO CLOSE AND RELEASE A FILE
*        KDELETE - TO DELETE A KEYED RECORD
*        KREAD - TO READ A KEYED RECORD
*        KWRITEN - TO WRITE A KEYED RECORD WITH A NEWKEY
*        KWRITEO - TO OVERWRITE A KEYED RECORD
*
*        SAMPLE CALLS FOLLOW:
*
*
*        CALL KOPEN  (UNIT,MODE,*NAME*,*SN*,ERR)
*                 WHERE UNIT IS A VALID FORTRAN DCB #
*                       MODE IS INTEGER:
*                       1-IN; 2-OUT; 4-INOUT; 8-OUTIN
*                 NAME IS OPTIONAL 12 WORD ARRAY
*                      WORDS 1-8    FILE NAME
*                            9-10   ACCOUNT (OR BLANK)
*                            11-12  PASSWORD (OR BLANK)
*                      NOTE: IS SN ISN'T SPECIFIED THEN
*                            *NAME* IS ON PUBLIC STORAGE
*                      CONTAINS THE NAME OF A PRIVATE
*                      VOLUME DISK PACK WHERE THE FILE
*                      WITH SPECIFIED IN *NAME* IS
*                      LOCATED
*                 ERR  I/O ERROR RETURNED IN Z2 FORMAT
*                 KEY  IS AN OPTIONAL ONE WORD INTEGER WHICH
*                      UPON RETURN WILL CONTAIN THE KEY OF
*                      THE LAST RECORD IN A SCANDATA FILE
*
*
*        CALL KOPENIN (UNIT,ERR)
*                 WHERE:
*                 UNIT IS THE FORTRAN I/0 UNIT NUMBER EG. 110
*                 ERR IS THE ADDRESS WHERE A I/O ERROR NUMBER
*                 WILL BE RETURNED. EG. IF AN I/O ERROR 46
*                 OCCURS X'46' WILL BE RETURNED IN THE ERR
*                 ADDRESS. ERR WILL BE INITIALIZED TO ZERO
*                 BEFORE ANY I/O OPERATIONS ARE PERFORMED.
*
*        CALL KOPENOUT (UNIT,ERR)
*                 SEE KOPENIN FOR ARGUMENTS
*
*        CALL KOPENIO (UNIT,ERR)
*                 SEE KOPENIN FOR ARGUMENTS
*
*        CALL KCLOSES (UNIT,ERR)
*                 SEE KOPENIN FOR ARGUMENTS
*
*        CALL KCLOSER (UNIT,ERR)
*                 SEE KOPENIN FOR ARGUMENTS
*
*        CALL KDELETE (UNIT,KEY,KEYSIZE,ERR)
*                 WHERE:
*                 UNIT - SEE KOPENIN
*                 KEY IS THE ADDRESS OF THE KEY
*                 KEYSIZE IS THE SIZE OF THE KEY
*                 ERR - SEE KOPENIN
*
*        CALL KREAD (UNIT,KEY,KEYSIZE,BUF,BUFSIZE,ERR,ARS)
*                 WHERE:
*                 UNIT - SEE KOPENIN
*                 KEY - SEE KDELETE
*                 KEYSIZE - SEE KDELETE
*                 BUFSIZE SI THE SIZE OF THE RECORD
*                 ERR - SEE KOPENIN
*                 ARS - THIS IS AN OPTIONAL ARGUEMENT
*                       IF ARS IS SPECIFIED, THE ACTUAL RECORDS
*                       SIZE WILL BE RETURNED TO THE MAINLINE
*                       PROGRAM.
*
*        CALL KWRITEN (UNIT,KEY,KEYSIZE,BUF,BUFSIZE,ERR)
*                 SEE KREAD FOR ARGUMENTS
*
*        CALL KWRITEO (UNIT,KEY,KEYSIZE,BUF,BUFSIZE,ERR)
*                 SEE KREAD FOR ARGUMENTS
*
***************************************************************
         PAGE
         SYSTEM   SIG7FDP
         SYSTEM   BPM
         SYSTEM   FORTLIB
         REF      9SETUPN,J:JIT
         DEF      KOPENIN,KOPENOUT,KOPENIO,KCLOSES,KCLOSER
         DEF      KDELETE,KREAD,KWRITEN,KWRITEO,KOPEN
         PAGE
KOPENIN  EQU      $
         LI,ND    2
         BAL,LR   9SETUPN
         INTG     UNIT
         INTG     ERR
         STW,LC   EXITBACK
         LW,AI    *UNIT
         LI,EN    OPENIN
         BAL,LL   7UNITADR
OPENIN   EQU      $
         BAL,6    SETDCB
         M:OPEN   *8DCBADR,(ERR,ERRX),(ABN,ERRX),(KEYED),;
                  (DIRECT),(IN),(SAVE),(KEYM,31),(RECL,32767)
         B        RESETERR
         PAGE
KOPENOUT EQU      $
         LI,ND    2
         BAL,LR   9SETUPN
         INTG     UNIT
         INTG     ERR
         STW,LC   EXITBACK
         LW,AI    *UNIT
         LI,EN    OPENOUT
         BAL,LL   7UNITADR
OPENOUT  EQU      $
         BAL,6    SETDCB
         M:OPEN   *8DCBADR,(ERR,ERRX),(ABN,ERRX),(KEYED),;
         B        RESETERR
         PAGE
KOPENIO  EQU      $
         LI,ND    2
         BAL,LR   9SETUPN
         INTG     UNIT
         INTG     ERR
         STW,LC   EXITBACK
         LW,AI    *UNIT
         LI,EN    OPENIO
         BAL,LL   7UNITADR
OPENIO   EQU      $
         BAL,6    SETDCB
         M:OPEN   *8DCBADR,(ERR,ERRX),(ABN,ERRX),(KEYED),;
                  (DIRECT),(INOUT),(SAVE),(KEYM,31),(RECL,32767)
         B        RESETERR
         PAGE
KCLOSES  EQU      $
         LI,ND    2
         BAL,LR   9SETUPN
         INTG     UNIT
         INTG     ERR
         STW,LC   EXITBACK
         LW,AI    *UNIT
         LI,EN    CLOSES
         BAL,LL   7UNITADR
CLOSES   EQU      $
         BAL,6    SETDCB
         M:CLOSE  *8DCBADR,(SAVE)
         B        RESETERR
         PAGE
KCLOSER  EQU      $
         LI,ND    2
         BAL,LR   9SETUPN
         INTG     UNIT
         INTG     ERR
         STW,LC   EXITBACK
         LW,AI    *UNIT
         LI,EN    CLOSER
         BAL,LL   7UNITADR
CLOSER   EQU      $
         BAL,6    SETDCB
         M:CLOSE  *8DCBADR,(REL)
         B        RESETERR
         PAGE
KDELETE  EQU      $
         LI,ND    4
         BAL,LR   9SETUPN
         INTG     UNIT
         INTG     KEY
         INTG     KEYSIZE
         INTG     ERR
         STW,LC   EXITBACK
         LW,AI    *UNIT
         LI,EN    DELETE
         BAL,LL   7UNITADR
DELETE   EQU      $
         BAL,6    SETDCB
         BAL,6    SETKEY
         B        RESETERR
         PAGE
KREAD    EQU      $
         CI,R14   7               WAS ARS SPECIFIED IN CALL
         BE       KREADARS
         LI,ND    6
         BAL,LR   9SETUPN
         INTG     UNIT
         INTG     KEY
         INTG     KEYSIZE
         INTG     BUF
         INTG     BUFSIZE
         INTG     ERR
         B        SERCHUNIT
KREADARS EQU      $
         LI,ND    7
         BAL,LR   9SETUPN
         INTG     UNIT
         INTG     KEY
         INTG     KEYSIZE
         INTG     BUF
         INTG     BUFSIZE
         INTG     ERR
         INTG     ARS
         LI,R6    0
         STW,R6   *ARS            INITIALIZE ARS
SERCHUNIT EQU     $
         STW,15   EXITBACK
         STW,14   NUMARGS         SAVE NUMBER OF ARGS
         LW,12    *BUFSIZE
         SLS,12   -2
         STW,12   6
         SLS,12   2
         CW,12    *BUFSIZE
         BE       $+2
         AI,6     1
         AI,6     -1
         LW,12    SPACE
         STW,12   *BUF
         CI,6     1
         BE       $+3
         STW,12   *BUF,6
         BDR,6    $-1
         LW,AI    *UNIT
         LI,EN    READ
         BAL,LL   7UNITADR
READ     EQU      $
         LI,R6    0
         STW,R6   *ERR            INTIALIZE ERROR CODE
         BAL,6    SETKEY
         LW,15    *BUFSIZE
         M:SETDCB *8DCBADR,(ABN,GETARS),(ERR,ERRX)
         M:READ   *8DCBADR,(KEY,THEKEY),(BUF,*BUF),(SIZE,*15),;
                  (ERR,ERRX),(ABN,GETARS)
         LI,6     ENDREAD
REQARS   EQU      $
         CI,14    7
         BNE      *6
         LI,R5    4
         LW,R13   *8DCBADR,5
         SLS,R13  -17
         STW,13   *ARS
         B        *6
GETARS   EQU      $
         LI,6     ERRX
         B        REQARS
ENDREAD  EQU      $
         B        RESETERR
         PAGE
KWRITEN  EQU      $
         LI,ND    6
         BAL,LR   9SETUPN
         INTG     UNIT
         INTG     KEY
         INTG     KEYSIZE
         INTG     BUF
         INTG     BUFSIZE
         INTG     ERR
         STW,LC   EXITBACK
         LW,AI    *UNIT
         LI,EN    WRITEN
         BAL,LL   7UNITADR
WRITEN   EQU      $
         BAL,6    SETDCB
         BAL,6    SETKEY
         LW,15    *BUFSIZE
         M:WRITE  *8DCBADR,(KEY,THEKEY),(BUF,*BUF),(SIZE,*15),;
                  (ERR,ERRX),(ABN,ERRX),(NEWKEY)
         B        RESETERR
         PAGE
KWRITEO  EQU      $
         LI,ND    6
         BAL,LR   9SETUPN
         INTG     UNIT
         INTG     KEY
         INTG     KEYSIZE
         INTG     BUF
         INTG     BUFSIZE
         INTG     ERR
         STW,LC   EXITBACK
         LW,AI    *UNIT
         LI,EN    WRITEO
         BAL,LL   7UNITADR
WRITEO   EQU      $
         BAL,6    SETDCB
         BAL,6    SETKEY
         LW,15    *BUFSIZE
         M:WRITE  *8DCBADR,(KEY,THEKEY),(BUF,*BUF),(SIZE,*15),;
                  (ERR,ERRX),(ABN,ERRX),(NEWKEY),(ONEWKEY)
         B        RESETERR
         PAGE
SETDCB   EQU      $
         LI,10    0
         STW,10   *ERR
         B        *6
         PAGE
SETKEY   EQU      $
         LW,12    KEY
         SLS,12   2
         LW,13    KEYADDR
         AI,13    1
         LW,14    *KEYSIZE
         STB,14   13
         MBS,12   0
         STB,14   THEKEY
         B        *6
         PAGE
ERRX     EQU      $
         LB,1     10                GET ERRCODE
         CI,1     3                 NO SUCH FILE?
         BNE      ERRX1             NOPE, SOME OTHER ERROR
         LI,1     0
         STW,1    *IKEY             NO FILE EXTENSION SO TELL DRIVER
         LI,1     2
         STW,1    :MODE             GO BACK AND OPEN IT OUT
         B        LOADCNT1
ERRX1    EQU      $
         SLS,10   -24
         STW,10   *ERR
         B        RESETERR
         PAGE
KOPEN    EQU      $
         CI,14    4               CHECK # OF ARGUMENTS
         BGE      OPENFILE
         LI,ND    3
         BAL,LR   9SETUPN         GET 3 ARGUMENTS
         INTG     UNIT
         INTG     MODE
         INTG     ERR
         STW,LC   EXITBACK
         LW,AI    *UNIT           GET DCB ADDRESS
         LI,EN    $+2
         BAL,LL   7UNITADR
         LI,12    0               ZERO OUT ERR
         STW,12   *ERR
         LW,12    OPEN1+8         LOAD IN MODE
         SLS,12   -4
         SLS,12   4
         OR,12    *MODE
         STW,12   OPEN1+8
         BAL,R6   SETDCB
,OPEN1   M:OPEN   *8DCBADR,(ABN,ERRX),(ERR,ERRX),(RECL,32767),;
                  (TRIES,10),(KEYED),(DIRECT),(IN),(SAVE),(KEYM,31)
         B        RESETERR
         SPACE    5
         PAGE
         CI,R14   6               IS SN OPTION THERE
         BGE      OPENSN          YES
         LI,ND    5               PUBLIC FILE
         BAL,LR   9SETUPN
         INTG     UNIT
         INTG     MODE
         INTG     NAME
         INTG     ERR
         INTG     IKEY
         B        GETDCBADDR
         SPACE    3
OPENSN   EQU      $               PRIVATE VOLUME FILE
         LI,ND    6
         BAL,LR   9SETUPN
         INTG     UNIT
         INTG     MODE
         INTG     NAME
         INTG     SN
         INTG     ERR
         INTG     IKEY
         SPACE    3
GETDCBADDR EQU    $               GET ADDRESS OF DCB
         STW,LC   EXITBACK        SAVE RETURN ADDRESS
         LW,AI    *UNIT
         LI,EN    $+2
         BAL,LL   7UNITADR
         SPACE    3
         LW,R12   $OPENFPT        REINITIALIZE FPT
         STW,R12  :OPENFPT
         LW,R12   $FILE
         STW,R12  :FILE
         LW,R12   $ACCOUNT
         STW,R12  :ACCOUNT
         LW,R12   $PASSWORD
         STW,R12  :PASSWORD
         LW,R12   $SN
         STW,R12  :SN
         LI,R4    0               LOAD VARIABLE PARAMS WITH BLANKS
         LW,R12   SPACE
         STW,R12  :FILEFILL,R4
         STW,R12  :ACCTFILL,R4
         STW,R12  :PASSFILL,R4
         STW,R12  :SNFILL,R4
         AI,R4    1
         CI,R4    2
         BL       $-6
         STW,R12  :FILEFILL,R4
         AI,R4    1
         CI,R4    8
         BL       $-3
         SPACE    3
         LI,R1    1               INDX POINTER
         LI,R2    2               WORDS USED & INDX PTR TO SAME
         LI,R3    1               END OF SIGNIFICANT WORDS INDICATOR
         LW,R15   $PF             R15 WILL BE MODIFIED TO TURN ON PF
         CI,R14   5               FLAGS. WAS SN SPECIFIED?
         BE       CKSN1           NO
         OR,R15   SNMSK           SN THERE - MASK PF
         STB,R1   :SN,R2          1 WORDS USED
         STB,R3   :SN,R1          LAST PARAM
         LI,R3    0               TURN OFF LAST PARAM IND
         LW,R10   *SN
         STW,R10  :SNFILL
         B        CKPASS
CKSN1    EQU      $
         LW,4     8DCBADR           GET THE DCB ADDRESS
         AI,4     X'25'             INDEX TO SN KEYWORD
         LW,13    *4
         AND,13   =X'FFFF00FF'      MAKE SURE NO VALID WORDS
         M:SYS                      GO MASTER
         STW,13   *4
         LPSD,0   SNLDATA
         BOUND    8
SNLDATA  EQU      $
         GEN,8,4,20 0,X'E',$+2
         DATA     0
         SPACE    3
CKPASS   EQU      $               SEE IF PASSWORD IS THERE
         LI,R4    10
         CW,R12   *NAME,R4        COMPARE TO BLANKS
         BE       CKPASS1         NOT THERE
         LW,R13   *NAME,R4
         STW,R13  :PASSFILL       FILL IN VALUE
         AI,R4    1
         LW,R13   *NAME,R4
         STW,R13  :PASSFILL+1
         OR,R15   PASSMSK         MASK PF FLAGS
         STB,R2   :PASSWORD,R2    2 WORDS USED
         STB,R3   :PASSWORD,R1    LAST PARAM
         LI,R3    0               TURN OFF END OF PARAM
         B        CKACCT
CKPASS1  EQU      $
         LW,4     8DCBADR
         AI,4     X'22'             INDEX TO PASS KEY WORD
         LW,13    *4
         AND,13   =X'FFFF00FF'      GET RID OF USEFULL WDS INDICATOR
         STW,13   *4
         LPSD,0   PASLDATA
         BOUND    8
PASLDATA EQU      $
         GEN,8,4,20 0,X'E',$+2
         DATA     0
         SPACE    3
CKACCT   EQU      $               IS ACCOUNT THERE
         LI,R4    8
         CW,R12   *NAME,R4        IS IT BLANK
         BE       CKACCT1         YES
         LW,R13   *NAME,R4        FILL IN ACCOUNT
         STW,R13  :ACCTFILL
         AI,R4    1
         LW,R13   *NAME,R4
         STW,R13  :ACCTFILL+1
         B        CKACCT2
CKACCT1  EQU      $
         LW,13    J:JIT+1         PUT RUNNING ACCOUNT IN
         STW,13   :ACCTFILL       OPEN FPT
         LW,13    J:JIT+2
         STW,13   :ACCTFILL+1
CKACCT2  EQU      $
         OR,R15   ACCTMSK         MASK PF FLAGS
         STB,R2   :ACCOUNT,R2     2 WORDS USED
         STB,R3   :ACCOUNT,R1     LAST PARAMETER
         LI,R3    0               TURN OFF LAST PARAMETER
         SPACE    3
CKFILE   EQU      $               MOVING FILE NAME
         STB,R3   :FILE,R1        LOAD IN LAST PARAMETER
         STW,R15  :PF             LOAD PF FLAGS INTO FPT
         LI,R3    8
         STB,R3   :FILE,R2        8 WORDS USED
         LI,R1    0               COUNT & LOAD FILE NAME BYTES
         LB,R12   *NAME,R1
         CI,R12   X'40'           IS BYTE BLANK
         BE       LOADCNT         YES
         AI,R1    1               NO - DISPLACE & MOVE
         STB,R12  :FILEFILL,R1
         B        $-5
         SPACE    3
LOADCNT  EQU      $               LOAD COUNT & FINISH FPT
         STB,R1   :FILEFILL       STORE COUNT
         LW,R1    *MODE
         STW,R1   :MODE           STORE MODE
         STW,R1   *ERR            REINITIALIZE ERROR TO ZERO
         LI,R12   8DCBADR         LOAD DCB ADDR INTO FPT
         OR,R12   :OPENFPT
         STW,R12  :OPENFPT
         SPACE    3
         BAL,R6   SETDCB
LOADCNT1 CAL1,R1  :OPENFPT        DO M:OPEN CALL
         LW,1     :MODE
         CI,1     2                 OUTPUT MODE?
         BE       RESETERR          YES
         M:PFIL   *8DCBADR,(EOF)    NO SO GET LAST KEY
         M:PRECORD *8DCBADR,(N,1),(REV)
         M:GP     1
         M:READ   *8DCBADR,(BUF,*9),(SIZE,120)
         LI,1     10
         LW,1     *8DCBADR,1        KET KBUF
         AND,1    =X'1FFFF'
         LW,2     *1                GET FIRST WORD OF KEY
         AI,1     1
         LW,3     *1                GET SECOND WORD
         SLD,2    8                 GET RID OF TEXTC COUNT
         STW,2    *IKEY             TELL THE DRIVER LAST KEY
         M:REW    *8DCBADR
         M:FP     1
         B        RESETERR        BRANCH BACK
RESETERR M:SETDCB *8DCBADR,(ERR,8TERA),(ABN,8TERA)
         B        *EXITBACK
         PAGE
***************************************:
*   UNITADR SUBROUTINE TO SEARCH DCBNAME TABLES IN TCB
*     AND RETURN THE LOCATION OF THE DCB IN 8DCBADR
* CALLING SEQUENCE
*      BINARY UNIT NUMBER IN REG 9
*      RETURN ADDRESS IN REG 5
*      ADDRESS OF DCB IS PUT INTO 8DCBADR
*       DCBNAME(F:XXX) IS IN 8UNITNAM TEXTC
*******************************************
7UNITADR EQU      $
         LCFI     0
         STM,R0   7UNITSAVE
         STW,R5   7BACK
         STW,R9   8UNITVAL    SAVE UNIT# AND RETURN ADDR
         LW,R5    SPACE
         STW,R5   8UNITNAM    BLANK OUT THE
         LI,R5    7
         LW,R15   9
BINX     LI,R14   0
         DW,R14  =10
         AI,R14   X'F0'    CONVERTING BIN TO EBCDIC
         STB,R14  8UNITNAM,R5 PUT AWAY THE BYTE
         AI,R5    -1    MORE TO DO?
         AI,R15   0
         BGZ      BINX   YEP
*
* FIX UP JUSTIFICATION AND PADDING
*
         LD,R14   8UNITNAM
7FIXIT   LB,R5    R14
         CI,R5    X'F0'   LEADING ZEROES......
         BG       7SET
         SLD,R14  +8
         LI,R5    3
         LI,R12   X'40'
         STB,R12  R15,R5   PUT IN TRAILING BLANK FOR SLD
         B        7FIXIT
7SET     SLD,R14  -16
         LI,R5    'F:'   PUT ON PROPER SUFFIX
         STH,R5   R14
         SLD,14   -8
         STD,R14  8UNITNAM    PUT AWAY WITH SPOT FOR BYTE COUNT
*
*   SET UP BYTE COUNT
*
         LI,R5    7
7LP      LB,R14   8UNITNAM,R5
         CI,R14   X'40'
         BNE      7FIXED
         AI,R5    -1
         B        7LP     GO CHECK NEXT BYTE
7FIXED   EQU      $
         STB,R5   8UNITNAM    NOW IT IS TEXTC
7DCBSRCH EQU      $
         LI,BX    10
         LW,BX    *0,BX      GET ADDR OF DCBNAME TABLE
U01      LW,R5    0,BX              FIRST WORD OF TABLE
U02      AI,BX    1                 SKIP POINTER
         CW,BX    R5      END OF CURRENT TABLE ENTRY
         BE       U04               YES
         LI,DCX   0
         LB,DC    *BX
         AI,DC    4
         SLS,DC   -2
         AW,DC    BX
U03      LB,X3    8UNITNAM,DCX
         CB,X3    *BX,DCX
         BNE      U03A     CORRESPONDING BYTES DON'T MATCH
         AI,DCX   1
         BLE      U03
         B        U05       YES LOOK AT NEXT
U03A     LW,BX    DC
         B        U02   LOOK AT NEXT ENTRY
U04      LW,BX    *R5
         BNEZ     U01   GET NEXT LINKED TO ENTRY IN TABLE
         LB,R5    MSGXX
         AI,R5    8
         STB,R5   8UNITNAM
         LI,5     X'40'
         STB,R5   MSGXX
         M:PRINT  (MESS,8UNITNAM)
         LI,R5    X'AF'  RETURN ERROR CODE
         STW,R5   *ERR
         B        RESETERR
U05      LW,BX    *DC  COME HERE IF A MATCH IS FOUND
         STW,BX   8DCBADR   PUT AWAY THE ADDRESS AS ADVERTISED
         LW,R5    LIMDCB
         CI,R5    100
         BL       $+3
         M:PRINT  (MESS,TBLXCEED)
         M:XXX
         LW,R6    8UNITVAL        PUT DCB# IN R6
         CI,R5    0                ANYTHING IN DCB TABLE?
         BL       NEWENT           NO - ADD NEW ENTRY
         LI,R5    0
EXIST    EQU      $
         CW,R6    DCBSTBL,R5        UNIT # ALREADY IN TBL?
         BE       RESTOREREGS
         AI,R5    2
         CW,R5    LIMDCB
         BLE      EXIST
ADDNEW   EQU      $
         STW,R6   DCBSTBL,R5        ADD NEW ENTRY
         LW,R6    8DCBADR
         STW,R6   DCBSTBL+1,R5
         STW,R5   LIMDCB
         B        RESTOREREGS
NEWENT   EQU      $
         AI,R5    2
         B        ADDNEW
RESTOREREGS EQU   $
         LCFI,0   0
         LM,R0    7UNITSAVE
         B        *7BACK
         SPACE    3
8TERA    EQU      $           I/O ERROR CONDITION
         LI,R5    0
         LW,R11   1FFFF
COMSEL   EQU      $
         CS,R10   DCBSTBL+1,R5
         AI,R5    2
         CI,R5    LIMDCB
         BL       COMSEL
         M:PRINT  (MESS,SRCHXCEED)
         M:XXX
CONVERTNUM EQU    $
         LW,R7    DCBSTBL,R5         WHERE TO PUT NUMBER
         LI,R6    0
         LI,R5    28
TILLZERO EQU      $
         DW,R6    BYTEN
         OR,R6    FMASK
         STB,R6   IOMESS,R5
         AI,R5    0
         CI,R7    0
         BE       TOMERC
         LI,R6    0
         AI,R5    -1
         B        TILLZERO
TOMERC   EQU      $
         LW,R5    R10
         LI,R4    0
         LI,R3  12
         SLD,R4   4
         BAL,R1   LDERR
         SLD,R4   4
         BAL,R1   LDERR
         AI,R3    1
         SLD,R4   3
         BAL,R1   LDERR
         SLD,R4   4
         BAL,R1   LDERR
         M:PRINT  (MESS,IOMESS)
         M:XXX
LDERR    EQU      $
         LB,R2    HEXTBL,R4
         STB,R2   IOMESS,R3
         LI,R4    0
         AI,R3    1
         B        *R1
*********************************************
*  STORAGE TEMPS USED BY 7UNITADR
*********************************************
8DCBADR  RES      1
8UNITVAL RES      1
1FFFF    DATA     X'1FFFF'
7BACK    RES      1
7UNITSAVE RES     16
         BOUND    8
8UNITNAM RES      2
MSGXX    TEXTC    ':CAN''T FIND THIS DCB'
         PAGE
DCBSTBL  RES      100
LIMDCB   DATA     -2
SRCHDCB  RES      1
TBLXCEED TEXTC    ' DCB TABLE IN SEQIO   EXCEEDED - JOB ABORTED'
SRCHXCEED TEXTC    ' DCB TABLE IN SEQIO   EXCEEDED DURING SEARCH '
IOMESS   TEXTC    ' I/O ERROR XX XX ON UNIT     '
FMASK    DATA     X'F0'
BYTEN    DATA     10
HEXTBL   TEXT     '0123456789ABCDEF'
NAME     RES      1
SN       RES      1
MODE     RES      1
IKEY     RES      1
         SPACE    3
:OPENFPT RES      1               M:OPEN FPT
:PF      RES      1
:ERR     DATA     WA(ERRX)
:ABN     DATA     WA(ERRX)        ABN ADDRESS
:RECL    DATA     32767           RECORD SIZE
:TRIES   DATA     10              TRIES
:ORG     DATA     2               KEYED  FILE
:ACCESS  DATA     2               ACCESS IS DIRECT
:MODE    RES      1               MODE
:OPT     DATA     2               SAVE FILE
:KEYM    DATA     31              KEY MAX SIZE = 31
:FILE    RES      1               VARIABLE LENGTH PARAMETERS FOLLOW
:FILEFILL RES     8               FILE NAME
:ACCOUNT RES      1
:ACCTFILL RES     2               ACCOUNT NAME
:PASSWORD RES     1
:PASSFILL RES     2               PASSWORD NAME
:SN      RES      1
:SNFILL  RES      2               SN NAME FOR PRIVATE VOLUME
         SPACE    3
$OPENFPT GEN,8,24 X'94',0         INDIRECT ADDRESS OF DCB
$PF      GEN,4,4,4,4,16 X'D',X'F',4,8,1  PF FLAGS
$FILE    GEN,8,24 1,8
$ACCOUNT GEN,8,24 2,2
$PASSWORD GEN,8,24 3,2
$SN      GEN,8,24 7,1
         SPACE    3
SNMSK    DATA     X'40'
PASSMSK  DATA     X'200'
ACCTMSK  DATA     8
         SPACE    3
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
BX       EQU      4
DC       EQU      2
DCX      EQU      1
         PAGE
EXITBACK DATA     0
UNIT     DATA     0
ERR      DATA     0
KEY      DATA     0
KEYSIZE  DATA     0
BUF      DATA     0
BUFSIZE  DATA     0
THEKEY   RES      64
KEYADDR  DATA     BA(THEKEY)
DCB      DATA     0
NUMARGS  RES      1
ARS      RES      1
5F       DATA     X'FFFFF'
SPACE    DATA     X'40404040'
         END
