************************************************************************
*
*        GETPUT (VERSION C00)
*
************************************************************************
DMS      EQU      0
UTS      EQU      1
DCBREF   EQU      1
TEXT     EQU      1
#SNS     EQU      3
KEYM     EQU      4                 MAX KEY SIZE
************************************************************************
         DEF      ERRSET,OPENF,CLOSEF,REWF,SKIPF,SKIPR,WEOF
         DEF      DCBSET,DELREC,CLOSEV,GETR,PUTR,DCBNAME,DCB:ADDR
         DEF      IOFPT,EXITR,UTS,MODES
         DO1      DMS=0
         DEF      GET,PUT
         DEF      GETKEY,GETSIZE,GETSIZ
************************************************************************
         DO1      DCBREF
         REF      F:1,F:2,F:3,F:4
         REF      M:DO
************************************************************************
         SYSTEM   SIG7
         PAGE
************************************************************************
TCB:ADDR EQU      0
INDX     EQU      1
MIN      EQU      2
MAX      EQU      3
TEMP     EQU      4
COUNT    EQU      5
SIZE     EQU      6
ADDR     EQU      7
SOURCE   EQU      8
DESTIN   EQU      9
NAME     EQU      10
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
ARG      EQU      14
LINK     EQU      15
************************************************************************
         PAGE
************************************************************************
NOSCAN   EQU      0
OPENFILE EQU      X'94'
CLOSFILE EQU      X'95'
READFILE EQU      X'90'
WRTFILE  EQU      X'91'
REWFILE  EQU      X'81'
WEOFILE  EQU      X'82'
SKIPREC  EQU      X'9D'
SKIPFILE EQU      X'9C'
CLOSEVOL EQU      X'83'
DCB:SET  EQU      X'86'
SET:KEY  EQU      8
GET:SIZE EQU      9
GETKEYF  EQU      10
DELETE   EQU      12
NODCB    EQU      X'55'             NO DCB IS AVAILABLE
************************************************************************
         SPACE    5
************************************************************************
FPT      COM,1,7,24  1,AF(1),AF(2)  FIRST FPT WORD
IND      COM,1,31  1,AF(1)
DATAB    COM,8,8,8,8    AF(1),AF(2),AF(3),AF(4)
CALL     COM,1,7,4,3,17  AFA(1),X'6A',LINK,AF(2),AF(1)
GET:ARG  COM,8,4,20  X'6A',TEMP,GET:ARG
RETURN   COM,1,7,7,17  1,X'68',,LINK
EXITR    COM,8,24  X'68',EXITR
************************************************************************
         PAGE
************************************************************************
         BOUND    8
MAGTAPE  DATA     8,10
SR1SAVE  DATA     0
SR3SAVE  DATA     0
MODES    DATA     X'04000108',X'02080400'     FILE MODES
KEY      EQU      %
         RES      8                 MAX KEY SIZE
         BOUND    4
DIGITS   EQU      KEY
************************************************************************
NEXTARG  DATA     0
ARGADDR  DATA     0                 NEXT ARGUMENT ADDR
MODE     EQU      SR3SAVE           TEMP STORAGE
FLAG     EQU      SR1SAVE
LINKAGE  DATA     0
DCB:ID   DATA     0
#ARGS    DATA     0
EXITADDR DATA     0                 EXIT ADDRESS
DCB:FLG  EQU      EXITADDR
USERDCB  DATA     0                 USER DCB NUMBER
USERERR  DATA     0                 USER ERROR HANDLER
USERABN  DATA     0                 USER ABNORMAL HANDLER
ERRADDR  DATA     0                 ERROR CODE STORAGE
DCB:ADDR DATA     0                 ADDR OF DCB
DCBS     DATA     0,0,0             ALLOW 11 DCBS
DCBADDRS RES      6
************************************************************************
         PAGE
************************************************************************
FPTCODE  EQU      %
         DATA,1   1,X'D0',X'F0',X'F8',X'F8',X'F8'
         BOUND    4
ONEWKEY  EQU      FPTCODE
************************************************************************
SEVEN    DATA     7
FFFF00   DATA     X'FFFF00'         MASK
TEN      DATA     10
M:       DATA     X'00D47A00'       M:
F:       DATA     X'00C67A00'       F:
BLANK    DATA     X'40404040'
************************************************************************
         PAGE
************************************************************************
PFIL     FPT      X'1C',DCB:ADDR    POSITION FILE
         DATA     0                 POSTITION TO EOF
************************************************************************
SETDCB   FPT      X'1D',DCB:ADDR    SKIP RECORDS
         GEN,2,30 3,0                  RECORDS
         IND      COUNT                   BY
         IND      SIZE
************************************************************************
DEL:REC  FPT      13,DCB:ADDR       DELETE
         DATA     0                    RECORD FROM
         DATA     KEY                     FILE
         BOUND    8
************************************************************************
IOFPT    FPT      0,DCB:ADDR        GENERAL PURPOSE I/O FPT
         GEN,8,24 X'F8',X'30'
ADDRS    DATA     ERROR,ABNORM
BUFFADDR DATA     0
         IND      SIZE              BUFFER SIZE
         DATA     KEY               KEY BUFFER
************************************************************************
CLOSE    FPT      X'15',DCB:ADDR    CLOSE
         IND      1
         IND      ARG
***********************************************************************
         PAGE
************************************************************************
OPEN     FPT      X'14',DCB:ADDR    OPEN DCB
         DATA     X'C74D0009'
         DATA     ERROR
         DATA     ABNORM
ORGAN    DATA     1
ACCESS   DATA     1
         IND      TEMP              MODE
         DATA     2
KEYMAX   DATA     KEYM              MAX KEY SIZE
DEVICE   DATA     X'18700'
VOL      DATA     0
************************************************************************
         DATAB    1,0,3,3
FILENAME DATA,8   0
         DATA     0
************************************************************************
         DATAB    2,0,0,2
ACCOUNT  DATA,8   0
         DATAB    3,0,0,2
PASSWORD DATA,8   0
         DATAB    7,1,0,#SNS
************************************************************************
INSN     EQU      %
         RES      #SNS
************************************************************************
ERRFPT   GEN,8,24 X'11',M:DO
         GEN,4,28  3,16
         IND      ADDR
         IND      SIZE
         PAGE
************************************************************************
SAVE:REG EQU      %
         STW,SR2  LINKAGE           SAVE LINKAGE ADDR
         STB,SR1  IOFPT             SAVE OP CODE
         STB,SR1  SETDCB
         SLS,SR1  -8                GET MAX ARGS
************************************************************************
SET:ARGS EQU      %
         STW,LINK NEXTARG           NEXT ARG ADDR
         STW,LINK EXITADDR          RETURN ADDR
         AWM,ARG  EXITADDR          RETURN ADDR
         CW,ARG   SR1               EVALUATE
         BGE      %+2                  ARGUMENT
         LW,SR1   ARG                     NUMBERS
         STB,SR1  #ARGS                      & SAVE
************************************************************************
         LI,MAX   0                 CLEAR
         STB,MAX  DCB:FLG           CLEAR FLAG
         STW,MAX  DCB:ID            CLEAR
         MTB,0    IOFPT             DCB SEARCH?
         BEZ      *LINKAGE          RETURN
************************************************************************
         LW,ARG   *NEXTARG          ARG ADDR
         BGEZ     %+3
         LW,ARG   *ARG              ALLOW INDIRECT
         BLZ      %-1
         MTW,1    NEXTARG           INCR FOR LATER
         MTB,-1   #ARGS             DECR NUMBER OF ARGS
GET:DCB  STW,ARG  ARGADDR           SAVE ARGUMENT ADDR
         LB,TEMP  ARG               TEST FOR COBOL
         CI,TEMP  X'51'               ARG FLAG
         BE       SET:DCB           GOT ONE
GET:DCB2 LW,ARG   *ARG              GET ARGUMENT ITSELF
         DO       TEXT
         BGZ      SET:DCB           TRY IT FOR DCB ADDR
         LW,TEMP  ARG               COPY
         SLS,TEMP -8                ALIGN IT
         AND,TEMP FFFF00            CLEAR BITS
         CW,TEMP  F:                USER DCB?
         BE       %+3
         CW,TEMP  M:                MONITOR DCB?
         BNE      GET:DCB2
         LI,MAX   11                MAXIMUM DCB NAME LENGTH
         LI,DESTIN  DCBNAME         DESTINATION
         CALL     CNTBYTES+2        MOVE IT IN
         B        UNITSET
         FIN
         PAGE
SET:DCB  EQU      %
         STW,ARG  DCB:ID            SAVE DCB ID
         STW,ARG  DCB:ADDR          SAVE POSSIBLE DCB ADDDR
         DO       UTS
         CI,ARG   X'8FFF'           IN DCB ADDR RANGE
         ELSE
         CW,ARG   TCB:ADDR          IS IT A DCB ADDR ALREADY?
         FIN
         BG       *LINKAGE          YES,RETURN
GETUNIT  CI,ARG   255               FIT IN TABLE?
         BG       SET:UNIT+1        NO
         LB,MAX   DCBS              ANYTHING THERE?
         BEZ      SET:UNIT          NO
         CB,ARG   DCBS,MAX          TRY TO MATCH
         BE       GOT:UNIT          GOT ONE
         BDR,MAX  %-2
         B        SET:UNIT
GOT:UNIT LH,ARG   DCBADDRS,MAX      GET DCB ADDR AND
         AW,ARG   TCB:ADDR             MAKE ADJ.
         B        SET:DCB+1
********************************************************************
*        SPECIAL COM
********************************************************************
SETUP    COM,8,4,12,8,12,20  X'22',SR1,AF(1),AF(2),X'6A9',SAVE:REG
         PAGE
************************************************************************
SET:UNIT EQU      %
         STB,ARG  DCB:FLG           SET FLAG
         LW,MAX   ARG               GET VALUE
         LI,SIZE  0                 CLEAR COUNT
SETUNIT2 AI,SIZE  1                 BUMP
         LI,MIN   0                 CLEAR REMAINDER
         DW,MIN   TEN               DECIMAL DIVIDE
         AI,MIN   X'F0'             ZONE BITS
         STB,MIN  DIGITS,SIZE       SAVE DIGIT
         AI,MAX   0                 END OF CONVERT?
         BGZ      SETUNIT2          NOT YET
************************************************************************
UNIT:SET EQU      %
         LW,MAX   F:                BUILD DCB
         STW,MAX  DCBNAME              NAME
         LI,ADDR  2                        IMAGE
         AI,ADDR  1                 BUILD IT BYTE
         LB,MAX   DIGITS,SIZE         BY BYTE
         STB,MAX  DCBNAME,ADDR           BY BYTE
         BDR,SIZE %-3
         STB,ADDR DCBNAME           FINAL DCBNAME SIZE
************************************************************************
UNITSET  EQU      %
         LW,MIN   TCB:ADDR          GET TCB ADDRESS
         AI,MIN   9                 TO POINTER
UNITSET2 EQU      %
         LW,MIN   1,MIN             GET DCBTAB ADDR
         BEZ      NO:DCB
         LW,MAX   0,MIN             GET END OF DCBTAB
************************************************************************
         PAGE
************************************************************************
SCAN:DCB EQU      %
         LW,ADDR  MIN               COPY
         AI,ADDR  1                 BUMP PTR
         CW,ADDR  MAX
         BGE      UNITSET2
         LB,SIZE  *ADDR             BYTE COUNT
         LW,ARG   SIZE              DITTO
         AI,ARG   7                 MAKE IT A
         SLS,ARG  -2                   WORD COUNT+1
         AW,MIN   ARG               POINT TO DCB ADDR
         CB,SIZE  DCBNAME           WILL OUR NAME FIT?
         BNE      SCAN:DCB          NO
************************************************************************
         LB,ARG   DCBNAME,SIZE      TEST
         CB,ARG   *ADDR,SIZE           FOR
         BNE      SCAN:DCB             MATCH
         BDR,SIZE %-3
         LW,ARG   *MIN              GET AND
         STW,ARG  DCB:ADDR            SAVE DCB ADDR
         MTW,0    DCB:ID            TEST DCB ID
         BNEZ     %+2               ALREADY SET
         STW,ARG  DCB:ID            SET IT
************************************************************************
GOT:DCB  EQU      %
         MTB,0    DCB:FLG           TEST FLAG
         BEZ      *LINKAGE          CLEAR, RETURN
         LB,MIN   DCB:FLG           GET FLAG
         LB,MAX   DCBS              GET COUNTER
         AI,MAX   1                 NEXT ENTRY
         CI,MAX   11                MAKE SURE IT FITS
         BG       *LINKAGE          WON'T FIT
         STB,MAX  DCBS              RESTORE IT
         STB,MIN  DCBS,MAX          PUT IN OURS
         SW,ARG   TCB:ADDR          TAKE AWAY TCB ADDR
         STH,ARG  DCBADDRS,MAX      SAVE DCB ADDR
         B        *LINKAGE
         PAGE
************************************************************************
EXITR    LW,SR1   SR1SAVE           RESTORE SYSTEM
         LW,SR3   SR3SAVE           REGISTERS
         B        *EXITADDR
************************************************************************
NO:DCB   EQU      %
************************************************************************
         LI,MIN   NODCB             SET ERROR CODE
         STB,MIN  SR3               SAVE THE ERROR CODE
         B        ERROR
************************************************************************
MOVE:ONE EQU      %
         GET:ARG                    GET AN ARG
         NOP
         STW,ARG  *DESTIN           SET IF NON-ZERO
         RETURN
************************************************************************
MOVE:TWO EQU      %
         GET:ARG                    GET AN ARG
         RETURN
         LCI      2                 YES, GET TWO WORDS
         LM,NAME  *ARGADDR            AND MOVE
         STM,NAME *DESTIN              TO DESTIN
         LI,INDX  -2                BACK INDEX
         MTB,2    *DESTIN,INDX      SET SIGNIFICANCE FLAG
         RETURN
************************************************************************
         PAGE
************************************************************************
CNTKEY   EQU      %
         LI,DESTIN  KEY             DESTINATION
         LI,INDX  48                DISPLACEMENT OF KEYM
         LB,MAX   *DCB:ADDR,INDX    GET KEYM
CNTBYTES GET:ARG                    GET AN ARG
         RETURN
         LI,INDX  0                 CLEAR INDEX
         LB,TEMP  *ARGADDR,INDX     GET CHAR
         BEZ      CNT:END           WE ARE FINISHED, EXITRLOOP
         CI,TEMP  X'40'             BLANK?
         BE       CNT:END           YES, WE ARE FINISHED.  EXITRLOOP
         AI,INDX  1                 BUMP INDEX
         STB,TEMP *DESTIN,INDX      MOVE BYTE TO DESTINATION
         CW,INDX  MAX               FINISHED?
         BL       CNTBYTES+3        NO, DO MORE
************************************************************************
CNT:END  STB,INDX *DESTIN           PUT IN BYTE COUNT
         RETURN
************************************************************************
GET:ARG  EQU      %
         LI,ARG   0                 DEFAULT
         MTB,0    #ARGS             ANYTHING THERE?
         BEZ      0,TEMP            NO, GET OUT
         MTB,-1   #ARGS             TAKE CARE OF THIS ONE
         LW,ARG    NEXTARG          MOVE ADDR
         MTW,1    NEXTARG           INCR ADDR FOR NEXT TIME
         LW,ARG   *ARG              GET ARG ADDR
         BLZ      %-1
         STW,ARG  ARGADDR             OF ARG
         LW,ARG   *ARG              GET ARG
         AI,ARG   0                 ANYTHING THERE?
         BEZ      0,TEMP            NO, RETURN
         CW,ARG   BLANK             ALL BLANK?
         BE       0,TEMP            YES, RETURN
         B        1,TEMP            NORMAL EXIT
         PAGE
************************************************************************
*        CALL     OPENF (UNIT,FILE,MODE,ACCT,PASS,ORG,ACC,
*                    DEV,SN,KEYM,VOL)
************************************************************************
OPENF    EQU      %
         SETUP    11,OPENFILE
         LI,NAME  0                 CLEAR
         LI,INDX  -2                SET INDEX
         STB,NAME FILENAME,INDX     CLEAR FILENAME COUNT
         STB,NAME FILENAME          CLEAR COUNTER
         STB,NAME ACCOUNT,INDX      CLEAR ACCOUNT COUNT
         STB,NAME PASSWORD,INDX     CLEAR PASSWORD COUNT
         STB,NAME INSN,INDX         CLEAR INSN COUNT
         STB,NAME FLAG              CLEAR POSITION FILE FLAG
************************************************************************
         LI,DESTIN  FILENAME        DESTINATION
         LI,MAX   15                MAX FILENAME SIZE
         CALL     CNTBYTES          ACTUAL FILE NAME
         LB,INDX  FILENAME          IS THERE A FILE NAME?
         BEZ      %+3               NONE
         LI,INDX  -2                INDEX TO FILE COUNT
         MTB,3    FILENAME,INDX     SET SIGNIFICANCE
         GET:ARG                    GET AN ARG
         NOP
         LW,INDX  ARG               SWAP
         AND,INDX SEVEN             KEEP IT DOWN
         LB,INDX  MODES,INDX        GET FILE MODE
         BNEZ     SET:MODE
         LI,INDX  4                 DEFAULT INOUT AND UPDATE
         STB,INDX FLAG              SET POSITION FILE FLAG
SET:MODE STB,INDX MODE              SET FPT MODE
************************************************************************
GET:ACCT EQU      %
         LI,DESTIN  ACCOUNT         DESTINATION
         CALL     MOVE:TWO          SET THE ACCT NUMBER
************************************************************************
GET:PASS EQU      %
         LI,DESTIN  PASSWORD        DESTINATION
         CALL     MOVE:TWO          SET THE PASSWORD
         PAGE
************************************************************************
GET:ORG  EQU      %
         LI,DESTIN  ORGAN              VALUE, IF ANY
         CALL     MOVE:ONE          MOVE IT
************************************************************************
GET:ACC  EQU      %
         LI,DESTIN  ACCESS             VALUE, IF ANY
         CALL     MOVE:ONE          MOVE IT
************************************************************************
GET:DEV  EQU      %
         GET:ARG                    GET AN ARGUMENT
         B        %+3
         CI,ARG   11                MAX DEVICES
         BLE      %+2
         LI,ARG   0                 DEFAULT TO 0 FOR DISC
         LI,MAX   3                 MASK
         LI,MIN   1                 DEFAULT TO FILE
         LB,TEMP  FILENAME          GET LENGTH OF FILE NAME
         BEZ      GET:DEV2          NOT FILE OR LABELED TAPE
         CLM,ARG  MAGTAPE           TAPE DEVICE?
         BCS,9    GET:DEV3          NO
         LI,MIN   2                 LABEL TYPE
         B        GET:DEV3          GO
GET:DEV2 LI,MIN   3                 NOT FILE OR LABELED TAPE
GET:DEV3 STS,MIN  OPEN+1            SET FLAG IN FPT
         SLS,ARG  8                 ALIGN DEVICE
         AI,ARG   X'18000'             TYPE &
         STW,ARG  DEVICE                  SAVE
         PAGE
************************************************************************
GET:INSN EQU      %
         GET:ARG                    GET AN ARG
         B        GETKEYFM
         CI,ARG   #SNS              MAX NUMBER
         BLE      %+2
         LI,ARG   #SNS              SET TO MAX
         LW,MAX   ARG               GET REAL NUMBER
         LI,INDX  -2
         LW,ARG   *ARGADDR,MAX      GET NEXT INSN
         STW,ARG  INSN-1,MAX         INTO AREA
         MTB,1    INSN,INDX         BUMP IT UP
         BDR,MAX  %-3
GETKEYFM EQU      %
         GET:ARG                    NEXT ARGUMENT
         LI,ARG   KEYM              DEFAULT
         STW,ARG  KEYMAX            SET IT
         GET:ARG                    GET VOLUME ID
         LI,ARG   1                 DEFAULT
         STW,ARG  VOL               SET IT
************************************************************************
OPENIT   EQU      %
         LB,TEMP  MODE              FILE MODE
         CAL1,1   OPEN              OPEN THE DCB
         MTB,0    FLAG              NEED TO POSITON?
         BEZ      EXITR             NO, GET OUT
         CAL1,1   PFIL              TO END OF FILE
         EXITR
         PAGE
************************************************************************
*        CALL     CLOSEF (UNIT,SAVE/RELEASE)
************************************************************************
CLOSEF   EQU      %
         SETUP    2,CLOSFILE
         GET:ARG                    GET NEXT ARG
         LI,ARG   2                 DEFAULT
         CAL1,1   CLOSE             DO IT
         EXITR                      BAD CALL
************************************************************************
*        CALL     REWF (UNIT)
************************************************************************
REWF     EQU      %
         SETUP    1,REWFILE
REWF2    EQU      %
         CAL1,1   IOFPT
         EXITR
************************************************************************
*        CALL     WEOF (UNIT)
************************************************************************
WEOF     EQU      %
         SETUP    1,WEOFILE
         B        REWF2
         PAGE
************************************************************************
*        CALL     CLOSEV (UNIT)
***********************************************************************
CLOSEV   EQU      %
         SETUP    1,CLOSEVOL
         B        REWF2
***********************************************************************
*        CALL     DELREC (UNIT,KEY,LENGTH)
************************************************************************
DELREC   EQU      %
         SETUP    3,DELETE
         LCI      0                 CLEAR
         MTB,0    #ARGS             ANY ARGS LEFT?
         BEZ      DELREC2           NO, DELETE
         CALL     CNTKEY            GET THE KEY
         GET:ARG                    GET ARG
         B        %+2               OKAY AS IS
         STB,ARG  KEY               HE GAVE US THE KEY LENGTH
         LCI      8                 CC
DELREC2  STCF     DEL:REC+1
         CAL1,1   DEL:REC           DELETE RECORD
         EXITR
***********************************************************************
*        CALL     DCBSET (UNIT)
***********************************************************************
DCBSET   EQU      %
         SETUP    1,DCB:SET
         LCI      2
         LM,COUNT ADDRS             GET ERROR AND ABNORM ADDRS
         CAL1,1   SETDCB            SET THE DCB
         EXITR
         PAGE
************************************************************************
*        CALL     SKIPR (UNIT,COUNT)
************************************************************************
SKIPR    EQU      %
         SETUP    3,SKIPREC
         LI,DESTIN  COUNT           DESTINATION
         CALL     MOVE:ONE          MOVE IT
         LI,DESTIN  TEMP               DIRECTION
         CALL     MOVE:ONE                FLAG
         LI,SIZE  ABNORM
         CAL1,1   SETDCB            SKIP RECORDS
         EXITR
************************************************************************
*        CALL     SKIPF (UNIT,COUNT)
************************************************************************
SKIPF    EQU      %
         SETUP    2,SKIPFILE
         LI,DESTIN  COUNT           MOVE THE
         CALL     MOVE:ONE             COUNT
         CAL1,1   PFIL              POSITION FILE
         BDR,COUNT   %-1
         EXITR
         PAGE
************************************************************************
*        CALL     GET (UNIT,BUFFER,BUFFSIZE,KEY,KEYSIZE)
************************************************************************
GETR     EQU      %
GET      EQU      %
         SETUP    5,READFILE
         LI,TEMP  X'10'             READ WITH WAIT
         B        PUT2
************************************************************************
*        CALL     PUT (UNIT,BUFFER,BUFFSIZE,KEY,KEYSIZE,NEWKEY)
************************************************************************
PUTR     EQU      %
PUT      EQU      %
         SETUP    6,WRTFILE
         LI,TEMP  X'70'             OVERWRITE KEY , NEWKEY, AND WAIT
         LB,MIN   #ARGS             GET NUMBER
         CI,MIN   5                 NEWKEY SPECIFIED
         BL       %+2               NO
         LI,TEMP  X'30'             NO, USE WAIT AND NEWKEY OPTION ONLY
************************************************************************
PUT2     EQU      %
         STW,TEMP IOFPT+1
         LB,MIN   #ARGS             GET ARG COUNT AS INDEX
         LB,MAX   FPTCODE,MIN       SET FPT CONTROL
         STB,MAX  IOFPT+1               CODE INTO FPT
         GET:ARG                    GET NEXT ARG
         NOP
         LW,TEMP  ARGADDR           GET ADDR OF BUFFER
         STW,TEMP BUFFADDR          SET INTO FPT
         LI,DESTIN  SIZE                 AND
         CALL     MOVE:ONE                   SIZE
         CALL     CNTKEY            GET THE KEY
         GET:ARG                    GET NEXT ARG
         B        GOT:KEY           NONE
         STB,ARG  KEY               SET REAL KEY LENGTH
GOT:KEY  EQU      %
         SLS,SIZE 2                 MAKE IT A BYTE COUNT
         CAL1,1   IOFPT             DO I/O OPERATION
         EXITR
************************************************************************
         PAGE
************************************************************************
*        CALL     ERRSET (ERRCODE,ABNORMAL,ERROR,UNIT)
************************************************************************
ERRSET   EQU      %
         SETUP    4,NOSCAN
         MTB,0    #ARGS             HOW MANY ARGS
         BNEZ     ERRSET1-1         SOME
         LI,TEMP  0                 NONE, SET TO
         STW,TEMP ERRADDR             ZERO AND EXIT
         EXITR
         LI,COUNT 4                 GET THEM ALL
ERRSET1  EQU      %
         GET:ARG                    GET AN ARG
         NOP                        WE JUST NEED THE ADDRESS
         LW,TEMP  ARGADDR           GET VALUE CURRENTLY IN MEMORY
         STW,TEMP USERDCB-1,COUNT     SET IT IN AS NEW VALUE
         BDR,COUNT  ERRSET1
         EXITR
************************************************************************
*        CALL     GETSIZE (UNIT,SIZE)
************************************************************************
GETSIZ   EQU      %
GETSIZE  SETUP    2,GET:SIZE
         GET:ARG                    GET AN ARG
         NOP                        IGNORE..WE WANT THE ADDR
         LI,INDX  8                 HALFWORD INDEX
         LH,TEMP  *DCB:ADDR,INDX    GET ARS
         SLS,TEMP -1                MAKE IT A BYTE COUNT
         B        GETKEYE
************************************************************************
*        CALL     GETKEY (UNIT,KEY,KEYSIZE)
************************************************************************
GETKEY   SETUP    3,GETKEYF
         GET:ARG                    GET AN ARG
         NOP                        IGNORE..WE WANT THE ADDR
         LI,INDX  10                WORD INDEX
         LW,MIN   *DCB:ADDR,INDX    GET KEY ADDRESS
         LB,INDX  *MIN              GET KEY SIZE
         LB,TEMP  *MIN,INDX         MOVE
         AI,INDX  -1                BYTE
         STB,TEMP *ARGADDR,INDX     TO USER
         BGZ      %-3
         GET:ARG                    GET AN ARG
         NOP                        INGORE..WE WANT THE ADDR
         LB,TEMP  *MIN              NOW SET SIZE
GETKEYE  STW,TEMP *ARGADDR            FOR USER
         EXITR
************************************************************************
ABNORM   EQU      %
         LI,INDX  0                 ABNORMAL INDEX
         B        ERROR+1
************************************************************************
ERROR    EQU      %
         LI,INDX  1                 ERROR INDEX
         LB,TEMP  SR3               CODE
         CI,TEMP  10                DOUBLE CLOSE?
         BE       *8                YES, IGNORE IT
         MTB,0    FLAG              UPDATE MODE?
         BEZ      ERROR2            NO
         CI,TEMP  3                 MISSING FILE?
         BNE      ERROR2
         LI,TEMP  8                 SET IT IN OUTIN MODE
         CAL1,1   OPEN              OPEN IN OUTIN MODE
         LI,ARG   2                 SAVE
         CAL1,1   CLOSE             CLOSE AND SAVE
         B        OPENIT+1
ERROR2   EQU      %
         STW,SR1  SR1SAVE           PRINT OUT A MESSAGE
         STW,SR3  SR3SAVE           FOR USER WHO DIDN'T CALL ERRSET
         MTW,0    ERRADDR           IS USER ADDR SPECIFIED
         BNEZ     SET:ERR           YES, GO TO IT
         LH,TEMP  SR3               GET ERR/ABN CODE AND SUBCODE
         SLD,TEMP -8                BREAK IT UP
         SLS,TEMP+1  -1             GET RID OF EXTRA BIT
         SLD,TEMP -8                EVERYTHING IN TEMP+1
         LI,INDX  0                 INITIAL INDEX FOR STORE
         LI,SIZE  4                 NUMBER OF DIGITS TO CONVERT
ERRLOOP  LI,TEMP  0                 CLEAR
         SLD,TEMP 4                 GET A DIGIT
         AI,TEMP  X'F0'             PUT IN ZONE BITS
         CI,TEMP  X'FA'             ALPHA?
         BL       %+2               NO
         AI,TEMP  -X'39'            YES, ADJUST FOR X'C1'-X'C6'
         STB,TEMP ERR#,INDX           AND STORE IT
         AI,INDX  1                 BUMP INDEX
         CI,INDX  2                 TEST FOR SUBCODE
         BNE      %+2               NOT YET, OR PASSED IT
         AI,INDX  1                 SUBCODE, BUMP AGAIN
         BDR,SIZE ERRLOOP           DO ALL DIGITS
         LI,ADDR  ERRGIVE                USE THE DOCUMENTATION
         DO       TEXT
         LI,SIZE  43                MESSAGE LENGTH
         ELSE
         LI,SIZE  35
         FIN
         CAL1,1   ERRFPT
         EXITR
ERRGIVE  TEXT     '**I/O ERR - '
ERR#     TEXT     'XX XX   ON DCB:'
DCBNAME  DATA     0,0
         DO1      TEXT
         DATA     0,0               ALLOW FOR TEXTC NAME
************************************************************************
SET:ERR  EQU      %
         STW,TEMP *ERRADDR          PUT IN ERROR CODE
         LW,TEMP  DCB:ID            GET DCB ID
         STW,TEMP *USERDCB          SET FOR USER
         AI,INDX  USERERR           EXITRADDRESS
         LW,INDX  *INDX             GET THE ERROR/ABNORMAL ADDRESS
         STW,INDX EXITADDR          SET EXITRADDR
         EXITR                      RETURN
************************************************************************
         END
