         SYSTEM   SIG7FDP
FPT      COM,8,24 AF(1),AF(2)
M        CNAME
         PROC
         USECT    OPTJMP
T4       SET      0
BOTS     SET      'B','O','T','S'
T5       SET      S:UT(AF(4))
T6       DO       NUM(T5)
T7       SET      0
T8       DO       4
T7       SET      BOTS(T8)=T5(T6)
T4       SET      T4|T7**(32-T8)
         FIN
         FIN
         DATA     T4+AF(1)
         LIST     0
         USECT    TXTS
T1       SET      %
         RES      1
         TEXT     AF(2)
         DO1      S:NUMC(AF(2))<=4
         TEXT     ' '
         TEXT     AF(3)
         DO       NUM(AF)>3
         TEXT     '    '
         TEXT     AF(4)
         FIN
T2       SET      BA(%)-BA(T1)-1
T3       SET      %
         ORG      T1
         FPT      T2,'   '
         ORG      T3
         USECT    OPTS
         DATA     T1+1
         USECT    WAIT
         LIST     1
         PEND
         PCC      0
SMSG     CNAME    0
SMSGI    CNAME    1
SMSGT    CNAME    2
         PROC
LF       LI,1     AF
         DO       NAME=0
         BAL,15   MSG
         ELSE
         BAL,15   TYPE
         DO1      NAME=1
         BAL,15   DECVAL
         FIN
         PEND
TC       CNAME
         PROC
         LIST     0
LF       TEXTC    AF
         LIST     1
         PEND
ER       CNAME
         PROC
         USECT    OPTS
         GEN,1,8,7 0,AF(1),AF(2)
         LIST     0
         USECT    TXTS
T1       SET      BA(%)
         TEXTC    AF(3)
         USECT    OPTJMP
         DATA     T1
         USECT    WAIT
         LIST     1
         PEND
ERCD     COM,1,8,7 0,AF(1),AF(2)
ERLC     CNAME
         PROC
         USECT    OPTS
         DATA     AF(1)
         LIST     0
         USECT    TXTS
T1       SET      BA(%)
         TEXTC    AF(2)
         USECT    OPTJMP
         DATA     T1
         USECT    WAIT
         LIST     1
         PEND
         PAGE
         DEF      MEI
         DEF      CBUFFER
         DEF      TLABEL
         DEF      GET8
         DEF      MSG
         DEF      DECVAL
         DEF      GETN
         DEF      DYNAMIC
         DEF      HEXTODEC
         DEF      HEXTODEC1
         DEF      DECVALX
         DEF      OPT%TYP
         DEF      TBUF
UTS      EQU      1
         DEF      BUFFER,WAIT,SETPMT,OPTS,OPTJMP,TXTS
         REF      M:SI,M:LO
CAL      CNAME
         PROC
LF       BAL,15   SET%CAL%TYPE
         GEN,1,7,4,20 AFA,4,CF(2),AF
         PEND
ST       EQU      %
         DEF      ST
OPNO     LI,1     2
         B        OPNIO+1
OPNOI  EQU        %
       LI,1       8
       B          OPNIO+1
OPNI     LI,1     1
         B        OPNIO+1
OPNIO    LI,1     4
         STW,1    MODE
         LH,1     MEI
         CI,1     X'20'
         BANZ     QNM
OPNIOC   CAL,1    OPNFPT
         B        WAIT
OPNFPT   FPT      X'14',MEI
         DATA     X'E76C1001'
         DATA     IOMSG,IOMSG
         PZE      *BUFFER
ORG      DATA     1                 CONSEC IS DEFAULT
ACC      DATA     1                 SEQUEN IS DEFAULT
MODE     DATA     1                 IN IS DEFAULT
RELSAVE  DATA     2
         DATA     FPARAM
KEYM     DATA     3                 3 IS DEFAULT
RSOURCE  EQU      %
         DATA     X'0000C4D7'
NEWX     EQU      %                 TEMP FOR NOW
RSTORE   DATA     1                 GIVE 1 FOR A STARTER
         DATA     X'01000808'
FNAM     TC       'DUMMY'
         RES      6
         DATA     X'02000002'
ACCT     RES      2
         DATA     X'03000002'
PASS     RES      2
         DATA     X'07010003'
SN       TEXT     'OUT1'
         TEXT     'OUT2'
         TEXT     'OUT3'
OPNFPT%SIZE EQU   %-OPNFPT
         RES      1
DEFAULT%OPN RES   OPNFPT%SIZE
OPN%TO%DEFAULT DATA (OPNFPT%SIZE*4)**24+BA(DEFAULT%OPN)
DEFAULT%TO%OPN DATA (OPNFPT%SIZE*4)**24+BA(OPNFPT)
*
RELEASE  EQU      %
         LI,1     1
         B        %+2
SAVE     EQU      %
         LI,1     2
         STW,1    RELSAVE
         B        WAIT
ORGK     LI,1     2
         STW,1    ORG
         B        WAIT
ORGS     LI,1     1
         STW,1    ORG
         LI,1     3
         STW,1    KEYM
         B        WAIT
ORGR     EQU      %
         LW,1     =X'00008800'
         LW,0     =X'00000800'
         STS,0    OPNFPT+1
         LI,1     3
         B        ORGS+1
*
ACCS     LI,1     1
         B        ACCD+1
ACCD     LI,1     2
         STW,1    ACC
         B        WAIT
*
SFNAM    EQU      %
         LI,1     31
         LI,2     FNAM
         BAL,10   GETN
         B        WAIT
*
SACCT    BAL,10   GET8
         LD,2     TBUF
         LW,1     =X'02000202'
         LCI      3
         STM,1    ACCT-1
         B        WAIT
*
RSACCT   LW,1     =X'02000002'
         STW,1    ACCT-1
         B        WAIT
*
SPASS    BAL,10   GET8
         LW,1     =X'03000202'
         LD,2     TBUF
         LCI      3
         STM,1    PASS-1
         B        WAIT
RPASS    EQU      %
         LW,1     =X'03000002'
         STW,1    PASS-1
         B        WAIT
SKEYM    BAL,15   DECVAL
         CI,1     31
         BG       QNM
         CI,1     1
         BL       QNM
         STW,1    KEYM
         LI,1     2                 SET ORG TO KEYED
         STW,1    ORG
         B        WAIT
*
SRSTOR   BAL,15   DECVAL
         STW,1    RSTORE
         B        WAIT
TESTCODE DATA     0
TSTABN   SMSGT    CODEMSG
         BAL,15   HEXVAL
         SLD,0    24
         SLS,1    1
         SLD,0    7
         STH,0    TESTCODE
         B        WAIT
CODEMSG  TC       'CODE(H)'
MESSG    LI,7     0
         LW,1     M:SI+4
         SLS,1    -17
         AI,1     -5
         LC       IBUF+1,1
         BCS,11   %+2
         BDR,1    %-2
         STB,1    IBUF+1
         BDR,7    %+2               NO MESSAGE FOR COMMENT
         CAL1,2   MESSI
         LI,1     IBUF+1
         BAL,15   MSG
         LI,1     0
         STW,1    CARD%PRESENT
         B        WAIT
MESSI    DATA     0,X'80000000',IBUF+1
SNEWX    SMSGI    SLIDEMSG
         CI,1     255
         BG       QNM
         LI,2     2
         STB,1    NEWX,2
         SMSGI    CONSECMSG
         CI,1     255
         BG       QNM
         LI,2     3
         STB,1    NEWX,2
         LW,0     =X'00008000'
         LW,1     =X'00008800'
         STS,0    OPNFPT+1
         B        WAIT
SLIDEMSG TC       'SLIDES(D)'
CONSECMSG TC      'CONSEC(D)'
*
KEY%MODE EQU      %
         SMSGI    KEY%MESS
         CI,1     0
         BLZ      QNM
         CI,1     1
         BG       QNM
         STW,1    KEY%TYPE
         B        WAIT
*
KEY%MESS TC       'EBCDIC = 0  HEX = 1'
*
KEY%TYPE DATA     0
*
KEY%INCR EQU      %
         SMSGI    KEY%AMNT
         CI,1     -8
         BL       KEY%INCRERR
         CI,1     7
         BG       KEY%INCRERR
         SLS,1    20
         LW,0     1
         LW,1     =X'00F00000'
         STS,0    INCR30
         STS,0    INCR40
         STS,0    INCR05
         B        WAIT
KEY%INCRERR EQU   %
         BAL,15   QNMR
         B        KEY%INCR
*
KEY%AMNT TC       'AMOUNT TO INCREMENT (-8 TO 7) (D)'
*
         PAGE
CLSS     EQU      %
         LI,1     2
         B        CLSR10
CLSPTL   LI,1     X'30'
         LI,0     X'10'
ST%PTL   EQU      %
         STS,0    CLSFPT+1
         B        WAIT
CLS%REM  EQU      %
         LI,1     X'30'
         LI,0     X'20'             SET REMOVE OPTION
         B        ST%PTL
CLSR     EQU      %
         LI,1     1
CLSR10   STW,1    CLSFPT+2
         LH,1     MEI
         CI,1     X'20'
         BAZ      QNM
CLSC     CAL,1    CLSFPT
         B        WAIT
CLSFPT   FPT      X'15',MEI
         PZE      *0
         DATA     2                 SAVE IS DEFAULT
CLSFPT%DEFAULT EQU  %
         FPT       X'15',MEI
         PZE      *0
         DATA     2
*
CVOL     SMSGT    ACVOL
         LI,1     1
         BAL,10   GETNT
         BE       IOMSG27
         SMSGT    ANYLAB
         LI,1     1
         BAL,10   GETNT
         BE       CVOL10
         LW,1 =X'20000000'
         B        CVOL10+1
CVOL10   LI,1     0
         STS,1    CVOLFPT+1
CVOL20   CAL,1    CVOLFPT
         B        WAIT
CVOLFPT  FPT      X'03',MEI
         DATA     0
         DATA     TLABEL
ACVOL    TC       'CVOL CONTROL DESIRED Y/CR'
ANYLAB   TC       'LABEL DESIRED Y/CR'
*
REW      CAL,1    REWFPT
         B        WAIT
REWFPT   FPT      1,MEI
*
PEOF     LI,1     0
         B        PBOF+1
PBOF     LI,1     X'10'
         STW,1    PFILFPT+1
PFILC    CAL,1    PFILFPT
         B        WAIT
PFILFPT  FPT      X'1C',MEI
         DATA     0
*
PRECF    LI,0     0
         B        PRECR+1
PRECR    LI,0     X'10'
         LI,1     X'10'
         STS,0    PRECFPT+1
         SMSGI    HOWMANY
         STW,1    PRECFPT+2
PRECC    CAL,1    PRECFPT
         B        WAIT
PRECFPT  FPT      X'1D',MEI
         GEN,2,30 -1,0
         DATA     0
         DATA     PRECABN
*
HOWMANY  TC       '# RECS(D)'
*
PRECABN  LB,1     10                ABN  CODE
         LI,2     BA(BOFMSG)
         CI,1     4                 IS IT BOF
         BE       %+4
         LI,2     BA(EOFMSG)
         CI,1     6
         BNE      IOMSG
         LW,1     MEI+4
         SLS,1    -17
         SW,1     PRECFPT+2
         LCW,1    1
         BAL,15   DECOUT
         B        WAIT
*
SIZE0    DATA     0
SETARS   SMSGI    BIGMSG
         STW,1    SIZE0
         B        WAIT
*
BOFMSG   TC       'BOF HIT AFTER '
EOFMSG   TC       'EOF HIT AFTER '
WRITE1   MTW,1    NUMBERWRITES
WRITE    LI,1     WRITE58
         STW,1    WRTTMP
WRITE05  LW,1     SIZE0
         BNEZ     NOSIZE
         SMSGI    BIGMSG
NOSIZE   STW,1    SIZE
         LW,1     NUMBERWRITES
         BNEZ     NOCOUNT
         SMSGI    HOWMANY
         STW,1    NUMBERWRITES
NOCOUNT  STW,1    STARTNUMBER
         LI,15    WRITE50+X'80000'
WRITE10  EQU      %
         LI,11    X'30'
         AND,11   MEI+5
         CW,15    KEYRTN
         BL       WRITE50
         STW,15   KEYRTN
         CI,11    X'20'             IS FILE KEYED
         BG       WRITE40           NO
         BDR,15   %+2               SETKEY ALWAYS DOES SOMETHING
         BL       WRITE50           CONSEC
         LW,2     KEY%TYPE
         BNEZ     HEX%KEY
         SMSGT    KEYMSGC
         LI,1     31
         LI,2     KEYBUF
         BAL,10   GETN
         STW,1    KEY%COUNT
         B        END%KEY           GO DO THE WRITES
WRITE40  SMSGI    BLOCKMSG
         STW,2    KEY%COUNT
         CI,2     0
         BEZ      END%KEY
         STW,1    BLOCK
         B        END%KEY
WRITE50  LW,3     WRMASK
         LI,2     0
         CI,11    X'20'
         BL       *WRTTMP
         BE       WRITE55           KEYED
         LW,2     RNDFLG
         B        *WRTTMP
WRITE55  LI,1     KEYBUF
         STW,1    KEYPTR
         LW,2     KEYFLG
         B        *WRTTMP
WRITE58  STS,2    WRTBITS
WRITE51  CAL,1    WRTFPT
         LB,1     WRTBITS
         LI,15    WRITE51           SET RETURN FOR INCRKEY
         MTW,-1   NUMBERWRITES
         BNEZ     INCRKEY
         B        WAIT
WRTFPT   FPT      X'11',MEI
WRTBITS  DATA     X'F0000010'
         DATA     IOMSG,IOMSG
         PZE      *BUFFER
SIZE     DATA     0
KEYPTR   EQU      %
BLOCK    DATA     0
RNDFLG   DATA     X'01000000'
KEYFLG   DATA     X'08000040'
WRMASK   DATA     X'09000060'
READMASK DATA     X'09000040'
WRTTMP   DATA     0
NUMBERWRITES DATA 0
STARTNUMBER DATA  0
*
BIGMSG   TC       'ARS(D)'
KEYMSGC  TC       'KEY(C)'
KEYMSGH  TC       'KEY(H)'
BLOCKMSG TC       'BLOCK(D)'
KEYBUF   FPT      3,0
         RES      8
*
*
HEX%KEY  EQU      %
         SMSGT    KEYMSGH
         LI,7     0
         STW,7    KEY%COUNT
         LI,1     BA(KEYBUF)+1
         STW,1    KEYBUFADR
KEY%LOOP EQU      %
         BAL,15   HEXVALX
         B        %+2
         B        END%KEY
         LW,2     HEXCOUNT
         AWM,2    KEY%COUNT
         LI,6     4
         SW,6     2
         SLS,6    3
         SLS,1    0,6
         LI,4     4                 BA(1)
         LW,5     KEYBUFADR
         STB,2    5
         MBS,4    0
         STW,5    KEYBUFADR
         LW,7     KEY%COUNT
         CI,7     35
         BL       KEY%LOOP
END%KEY  EQU      %
         LB,15    OPT%TYP           DID WE GET *
         LW,7     KEY%COUNT
         STB,15   KEY%COUNT         SAVE ANSWER
         BEZ      *KEYRTN
         LC       KEYRTN
         BCR,8    ENDKEY%1
         CI,11    X'20'             CHECK KETM FOR KEYED
         BNE      *KEYRTN
         LB,15    MEI+12
         CW,7     15
         BLE      %+2
         LW,7     15
ENDKEY%1 EQU      %
         STB,7    KEYBUF
         B        *KEYRTN
*
KEYRTN    DATA    X'FFF80000'
*
KEY%COUNT DATA    0
*
KEYBUFADR DATA    0
*
*
READL    LW,1     =X'F0000038'      SET ULBL BIT
         B        READ+1
READ1R   MTW,1    NUMBERWRITES
READR    LW,1     =X'F0000030'      SET REVERSE BIT
         B        READ+1
READ1    MTW,1    NUMBERWRITES
READ     LW,1     =X'F0000010'
         STW,1    READBITS
READ01   LI,1     READ05
         STW,1    WRTTMP
         B        WRITE05
READ05   EQU      %
         LC       KEY%COUNT         TEST FOR *
*                 * = ZERO LENGTH BUT DON'T USE A KEY FOR READ
         BCS,8    READ10
         AND,2    =X'09000000'
         LW,3     READMASK
         STS,2    READBITS
READ10   CAL,1    READFPT
         LW,1     =X'04000000'
         CW,1     TEST%TYPE
         BAZ      NO%COMPARE
         LW,5     MEI+13
         LW,2     BUFFER
         LW,3     CBUFFER
         SLD,2    2
COMP%LOOP EQU     %
         CI,5     255
         BLE      %+3
         LI,1     255
         B        %+2
         LW,1     5
         STB,1    3
         CBS,2    0
         BNE      COMP%ERR
         AI,5     -255
         BGZ      COMP%LOOP
NO%COMPARE EQU    %
         LW,15    MOVKEY
         MBS,15   BA(MEIKBF)-BA(KEYBUF)
         LB,1     READBITS
         LI,15    READ10
         MTW,-1   NUMBERWRITES
         BNEZ     INCRKEY
         B        WAIT
MOVKEY   FPT      32,BA(KEYBUF)
READFPT  FPT      X'10',MEI
READBITS DATA     X'F0000010'
         DATA     IOMSG,IOMSG
         PZE      *BUFFER
         PZE      *SIZE
         PZE      *BLOCK
COMP%ERR EQU      %
         SMSG     COMP%ERR%MESS
         LW,1     =X'00800000'
         CW,1     TEST%TYPE
         BAZ      COMP%ERR%NO%DUMP
         LW,1     BUFFER
         STW,1    SNAPSTRT
         LW,3     MEI+13
         AI,3     3
         SLS,3    -2
         STW,3    SNAPEND
         BAL,14   SNAP
         TEXTC    '   BUFFER'
         LW,1     CBUFFER
         STW,1    SNAPSTRT
         BAL,14   SNAP
         TEXTC    '   CBUFFER'
COMP%ERR%NO%DUMP EQU  %
         LI,8     NO%COMPARE
CHKERR   LCI      0
         STM,0    IOREGS
         B        IOMSG22A
COMP%ERR%MESS TC  'COMPARE FAILED'
*
PCHARS   DATA,10  ' ABCDEFGHI'
         DATA,7   X'4A4B4C4D4E4F50'
         DATA,9   'JKLMNOPQR'
         DATA,8   X'5A5B5C5D5E5F6061'
         DATA,8   'STUVWXYZ'
         DATA,6   X'6A6B6C6D6E6F'
         DATA,10  '0123456789'
         DATA,6   X'7A7B7C7D7E7F'
*
SNAPSTRT RES      1
SNAPEND  RES      1
SNAPSIZE DATA     64
OBUFZAP  FPT      136,BA(O%BUF)
*
SNAP     SMSG     SPACE
         LW,1     14
         BAL,15   MSG
         AI,2     4
         SLS,2    -2
         AW,14    2
         SMSG     SPACE
         LI,4     0
SNAP10   LW,1     OBUFZAP
         MBS,0    BA(BLKS)
         LI,5     BA(O%BUF)
         LI,6     BA(O%BUF)+53
         LW,9     SNAPSIZE
         CI,9     64
         BE       %+2
         LI,6     BA(O%BUF)+94
         LW,10    4
         BAL,11   SNAPHEX
         STB,9    O%BUF+1
         LI,9     4
         AI,5     1
SNAP20   LW,10    *SNAPSTRT,4
         BAL,11   SNAPHEX
         LI,13    4
SNAP30   SCS,10   8
         LI,1     X'3F'
         AND,1    10
         MTB,5    0,6               MAKE .
         MTB,6    0,6
         CB,10    PCHARS,1
         BNE      %+2
         STB,10   0,6
         AI,6     1
         BDR,13   SNAP30
         AI,4     1
         CW,4     SNAPEND
         BGE      SNAP40
         BDR,9    SNAP20
         CI,6     BA(O%BUF)+110
         BE       SNAP20-2
         SMSG     O%BUF+1
         B        SNAP10
SNAP40   SMSG     O%BUF+1
         B        *14
*
SNAPHEX  LI,13    8
         SCS,10   4
         LI,1     15
         AND,1    10
         LB,1     HEXCHARS,1
         STB,1    0,5
         AI,5     1
         BDR,13   SNAPHEX+1
         AI,5     2
         B        *11
*
*
INCRKEY  CI,1     8
         BANZ     INCR10
         CI,1     1
         BAZ      *15               CONSEC, DON'T DO ANYTHING
INCR05   MTW,1    BLOCK             RANDOM FILE INCREMENT BLOCK
         B        *15
INCR10   LB,1     KEYBUF            KEYED, INCREMENT KEY
INCR20   EQU      %
         LW,2     KEY%TYPE
         B        %+1,2
         B        INCR30
         B        INCR40
INCR30   MTB,1    KEYBUF,1
         LB,2     KEYBUF,1
         AND,2    =X'F'
         CI,2     9
         BLE      *15               PRINTABLE, RETURN
         AI,2     -9
         LB,3     KEYBUF,1          NOT PRINTABLE
         AND,3    =X'F0'            MAKE PRINTABLE
         AW,2     3                 AND PUT IT BACK
         STB,2    KEYBUF,1          AND PUT IT BACK
         BDR,1    INCR20            AND INCREMENT PREV BYTE
         B        INCR10            START OVER
*
INCR40   EQU      %
         MTB,1    KEYBUF,1
         BNC      *15
INCR45   EQU      %
         BDR,1    %+2
         B        *15
         MTB,1    KEYBUF,1
         BNC      *15
         B        INCR45
*
*
         BOUND    8
BLKS     TEXT     '       '
TBUF     RES      9
IBUF     RES      21
O%BUF    RES      34
ECB      DATA     0
PKEY     EQU      %
         LW,2     KEY%TYPE
         BNEZ     PKEYHEX
         SMSG     KEYBUF
         B        WAIT
*
PKEYHEX  EQU      %
         LI,6     1
         LB,5     KEYBUF
         LI,1     BA(O%BUF)+1
         LW,3     KEYBUF
         SLS,3    8                 RID OF KEY LENGTH
         LI,4     6
         BAL,15   HEXTODEC1
         AI,5     3
         BLZ      PKEYH1
PKEYH0   EQU      %
         LW,3     KEYBUF,6
         BAL,15   HEXTODEC
         AI,6     1
         AI,5     -4
         BGZ      PKEYH0
PKEYH1   EQU      %
         LB,5     KEYBUF
         SLS,5    1
         STB,5    O%BUF
         SMSGT    KEY%HEXMSG
         SMSG     O%BUF
         B        WAIT
*
KEY%HEXMSG TC     'KEY IN HEX ='
*
*
PBLOCK   EQU      %
         LW,1     MEIKBF
         B        PDEC
PARS     LW,1     MEI+4
         SLS,1    -17
         B        PDEC
PRWS     LW,1     MEI+13
PDEC     LI,2     8                 NO MSG
         BAL,15   DECOUT
         B        WAIT
*
*
PACCT    LI,4     2
PACCT01  LW,1     MEI+6
PACCT05  LW,3     *1
         LB,2     3
         CW,2     4
         BE       PACCT10
         LH,2     3
         CI,2     X'FF'
         BANZ     QNM
         AND,3    =X'FF'
         AW,1     3
         AI,1     1
         B        PACCT05
PACCT10  LI,2     8
         LW,0     *2,1
         STW,0    O%BUF,2
         BDR,2    %-2
         CI,4     1
         BE       PFNAM01
         LW,1     =X'BFFFFFF'
         STW,1    O%BUF
         SMSG     O%BUF
         B        WAIT
*
PFNAME   LI,4     1
         B        PACCT01
PFNAM01  SMSG     O%BUF+1
         B        WAIT
PRACCT   LI,1     JIT
         LI,4     0
         B        PACCT10
*
PSN      EQU      %
         LI,2     BA(SN)-2
         LI,3     0
         LB,4     0,2
         SLS,4    2
         STB,4    O%BUF
         AI,2     2
         STB,4    3
         AI,3     BA(O%BUF)+1
         MBS,2    0
         SMSG     O%BUF
         B        WAIT
*
SCBUFALL EQU      %
         LW,1     CBUFFER
         B        BUF%ALL
SBUFALL  EQU      %
         LW,1     BUFFER
BUF%ALL  AI,1     -1
         STW,1    WHICH%BUF
         SMSGT    VALUE
         BAL,15   HEXVAL
         LW,2     BUFSIZ
         STW,1    *WHICH%BUF,2
         BDR,2    %-1
         B        WAIT
*
VALUE    TC       'VALUE(H)'
*
LOTOLP   LI,1     M:LO
         LI,2     121               SET SNAP SIZE
LOTO10   EQU      %
         LI,4     OPNLO
LOTO15   LI,3     CLSLO
         STW,2    SNAPSIZE
         LH,2     *1
         CI,2     X'20'
         BAZ      LOTO20
         CAL1,1   *3
LOTO20   CAL1,1   *4
         B        WAIT
*
CLSLO    GEN,1,7,24 1,X'15',1
         PZE      *0
         DATA     2
OPNLO    GEN,1,7,24 1,X'14',1
         DATA     X'40000',X'D3D7'
*
LOTOME   LI,1     M:LO
         LI,2     64
LOTOME10 EQU      %
         LI,4     OPNLOME
         B        LOTO15
*
OPNLOME  GEN,1,7,24 1,X'14',1
         DATA     X'40000'
         DATA     X'0000E4C3'
*
CBUFOUT  EQU      %
         LW,1     CBUFFER
         B        BUFOUT+1
BUFOUT   EQU      %
         LW,1     BUFFER
         STW,1    SNAPSTRT
         SMSGI    #WDS
         STW,1    SNAPEND
         BAL,14   SNAP
SPACE    TEXTC    ' '
         B        WAIT
PDCB     EQU      %
         LI,2     MEI
         STW,2    SNAPSTRT
         LI,2     X'1FFFF'
         AND,2    MEI+10
         AI,2     8-MEI
         STW,2    SNAPEND
         BAL,14   SNAP
         TEXTC    '   DCB'
         B        WAIT
PFPARAM  EQU      %
         LI,1     FPARAM
         STW,1    SNAPSTRT
         LI,15    0
         INT,2    *15,1
         AND,3    =X'FF'
         AW,15    3
         AI,15    1
         CI,2     X'FF'
         BAZ      %-5
         STW,15   SNAPEND
         BAL,14   SNAP
         TEXTC    '   FPARAM'
         B        WAIT
POPT     EQU      %
         LW,1     =X'01000000'
         CW,1     TEST%TYPE
         BAZ      WAIT
         LW,1     =X'08000000'
         STS,1    TEST%TYPE
         B        WAIT
#WDS     TC       '# WDS(D)'
*
OPNXTA   CAL,1    NXTAFPT
         B        WAIT
*
NXTAFPT  GEN,8,1,23 X'14',1,MEI
         DATA     1
         DATA     X'00010002'
*
OPFSTA   CAL,1    FSTAFPT
         B        WAIT
*
FSTAFPT  GEN,8,1,23 X'14',1,MEI
         DATA     1
         DATA     X'02010002'
*
OPNXTF   CAL,1    NXTFPT
         B        WAIT
*
NXTFPT   FPT      X'14',MEI
         DATA     X'401'
         DATA     X'00010002'
*
OPFSTF   CAL,1    FSTFPT
         B        WAIT
*
FSTFPT   FPT      X'14',MEI
         DATA     X'401'
         DATA     X'01010002'
         PAGE
MLNK     RES      8
LNKRTN   DATA     0
LINK     LI,2     2
         SLS,2    24
         STW,2    MLNK
         LW,2     LNKRTN
         STW,2    MLNK+1
         SMSGT    LNKMSG
         LI,2     MLNK+1
         LI,1     11
         BAL,10   GETN
         BEZ      EXLNK
         AI,1     4
         SLS,1    -2
         AW,2     1
         LI,1     8
         BAL,10   GETN
         BEZ      %+3
         MTW,2    MLNK
         AI,2     2
         LI,1     8
         BAL,10   GETN
         BEZ      %+2
         MTW,1    MLNK
EXLNK    CAL,8    MLNK
         B        WAIT
LDTRC    LI,2     3
         B        LINK+1
LNKMSG   TC       'LMN,ACCT,PSWD'
         PAGE
TYPE     LB,2     TEST%TYPE
         CI,2     1
         BANZ     MSG
         CAL1,2   TYPER
         B        *15
TYPER    DATA     X'2000000',X'80000000',X'80000001'
MSG      LB,2     *1
         DO       UTS
         LI,3     X'FF'
         ELSE
         LI,3     X'D'
         FIN
         STB,3    *1
         AI,2     1
         CAL1,1   WRITELO
         AI,2     -1
         STB,2    *1
         B        *15
WRITELO  FPT      17,M:LO
         DATA     X'30000010'
         PZE      *1
         PZE      *2
*
QNM      LI,15    WAIT
QNMR     LI,1     EHMSG
         B        MSG
EHMSG    TEXTC    'EH?'
DECVALX  STW,15   DECRET
         LCI      15
         STCF     DECRET
         B        DEC05
DECVAL   STW,15   DECRET
DEC05    BAL,10   GET8
         LI,2     0
         XW,2     1
         BEZ      DECK
         LI,5     1
DEC10    AI,2     -1
         BLZ      *DECRET
         BGZ      DEC20
         LB,3     TBUF
         CI,3     '-'
         BNE      DEC20
         LCW,1    1
         B        *DECRET
DEC20    LB,3     TBUF,2
         CI,3     X'F0'
         BL       DECER
         AND,3    =X'F'
         CI,3     9
         BG       DECER
         MW,3     5
         AW,1     3
         MI,5     10
         B        DEC10
DECER    BAL,15   QNMR
         B        DEC05
DECK     LCF      DECRET
         BCR,15   *DECRET
         MTW,1    DECRET
         B        *DECRET
DECRET   RES      1
DECOUT   LI,3     BA(O%BUF)+1       MOVE MSG TO OBEUB
         LI,14    DECOUT3
DECOUT0  LB,5     0,2
         STB,5    3
         MBS,2    1
         AI,3     -1
         XW,3     1
         BGEZ     %+5
         LI,5     '-'
         AI,1     1
         STB,5    0,1
         LCW,3    3
         LI,5     1
         AI,1     1
         MI,5     10
         CW,3     5
         BGE      %-3
         LW,5     1                 SAVE LAST CHAR
DECOUT1  LI,2     0
         DW,2     =10
         AI,2     X'F0'
         STB,2    0,1
         AI,3     0
         BEZ      %+2
         BDR,1    DECOUT1
         B        *14
DECOUT3  AI,5     -BA(O%BUF)
         STB,5    O%BUF
         LI,1     O%BUF
         B        MSG
*
*
SET%CAL%TYPE EQU  %
         EXU      *15
         STCF     15                SAV CCS
         AI,15    1
         LH,14    TESTCODE          ZAP EXPECTED ABN
         STW,14   TESTCODE          AND CHECK IF IT WAS THERE
         BNEZ     %+3
         LC       15
         B        *15
         SMSG     NOCODE
         LW,8     15                SET RETURN FOR GO
         B        CHKERR
NOCODE   TC       'THAT WASN''T SUPPOSED TO WORK'
*
         PAGE
         DEF      WAT
WAT      EQU      %
WAIT     EQU      %
         LI,1     0
         STW,1    NUMBERWRITES
         STB,1    BUFFER
         SMSGT    NEXT
         BAL,10   GET8
         LI,1     NUMOPTS
         LD,2     TBUF
         LW,4     OPTS-1,1
         CW,2     0,4
         BNE      %+3
         CW,3     1,4
         BE       TEST%VALID
         BDR,1    %-5
         MTW,0    USER%PROG
         BEZ      QNM
         LI,15    WAIT
         B        *USER%PROG
*
USER%PROG DATA    USERPROG
         SREF     USERPROG
TEST%VALID EQU    %
         LW,2     OPTJMP-1,1
         CW,2     TEST%TYPE
         BANZ     QNM
         B        0,2
TEST%TYPE DATA    0
*        TEST%TYPE HAS THE FOLLOWING MEANINGS
*        X'80000000'                BATCH
*        X'40000000'                ONLINE
*        X'20000000'                TEST MODE
*        X'10000000'                SIMULATION MODE
*        X'08000000'                PRINT OPTION
*        X'04000000'                COMPARE MODE
*        X'02000000'                ERROR OPTION
*        X'01000000'                FILE MODE
*        X'00800000'                COMPARE DUMP OPTION
NEXT     TC       'NEXT'
         CSECT
OPTS     EQU      %
         CSECT
OPTJMP   EQU      %
         CSECT
TXTS     EQU      %
         USECT    WAIT
         M        OPNO,'OPNO','OPEN DCB OUT'
         M        OPNI,'OPNI','OPEN DCB IN'
         M        OPNIO,'OPNIO','OPEN DCB INOUT'
         M        OPNOI,'OPNOI','OPEN DCB OUTIN'
         M        OPNXTF,'OPNXTF','OPEN NEXT FILE'
         M        OPFSTF,'OP1STF','OPEN FIRST FILE'
         M        OPNXTA,'OPNXTA','OPEN NEXT ACCOUNT'
         M        OPFSTA,'OP1STA','OPEN FIRST ACCOUNT'
         M        RELEASE,'REL','SET RELEASE IN OPEN FPT'
         M        SAVE,'SAVE','SET SAVE IN OPEN FPT'
         M        ORGK,'ORGK','SET ORG TO KEYED'
         M        ORGR,'ORGR','SET ORG TO RANDOM'
         M        ORGS,'ORGC','SET ORG TO CONSEC'
         M        ACCS,'ACCS','SET ACCESS TO SEQUEN'
         M        ACCD,'ACCD','SET ACCESS TO DIRECT'
         M        SFNAM,'SFNAM','SET FILE NAME'
         M        SACCT,'SACCT','SET ACCOUNT'
         M        SRACCT,'SRACCT','SET RUNNING ACCOUNT','BO'
         M        RSACCT,'RACCT','TURN ACCOUNT OFF'
         M        SPASS,'SPASS','SET PASSWORD'
         M        RPASS,'RPASS','TURN PASSWORD OFF'
         M        SKEYM,'SKEYM','SET KEYMAX'
         M        KEY%MODE,'KEYMODE','SET KEY MODE-HEX/EBCDIC'
         M        KEY%INCR,'KEYINCR','SET KEY INCREMENT (-8 TO 7)'
         M        SRSTOR,'SRSTOR','SET RSTORE'
         M        CLSS,'CLSS','CLOSE DCB WITH SAVE'
         M        CLSR,'CLSR','CLOSE DCB WITH RELEASE'
         M        REW,'REW','REWIND DCB'
         M        PEOF,'PEOF','POSITION DCB TO EOF'
         M        PBOF,'PBOF','POSITION DCB TO BOF'
         M        PRECF,'PRECF','POSITION RECORD FORWARD'
         M        PRECR,'PRECR','POSTION RECORD REVERSE'
         M        WRITE,'WRITE','WRITE RECORDS'
         M        WRITE1,'WRITE1','WRITE ONE RECORD'
         M        READ1,'READ1','READ ONE RECORD'
         M        READ1R,'READ1R','READ ONE RECORD REVERSE'
         M        READ,'READ','READ RECORDS'
         M        READR,'READR','READ RECORDS REVERSE'
         M        HELP,'HELP','GET HELP'
         M        SETBUF,'SBUF','PUT EBCDIC DATA IN BUFFER'
         M        SETCBUF,'SCBUF','PUT EBCDIC DATA IN COMPARE BUFFER'
         M        SETBUFD,'SBUFD','PUT DECIMAL DATA IN BUFFER'
         M        SETCBUFD,'SCBUFD','PUT DECIMAL DATA IN COMPARE BUFFER'
         M        SETBUFH,'SBUFH','PUT HEX DATA IN BUFFER'
         M        SETCBUFH,'SCBUFH','PUT HEX DATA IN COMPARE BUFFER'
         M        SBUFALL,'SBUFALL','SET BUFFER TO ONE VALUE'
         M        SCBUFALL,'SCBUFALL','SET COMPARE BUFFER TO ONE VALUE'
         M        QUIES,'QUIES','MAKE SYSTEM QUIESCENT','BO'
         M        EXIT,'END','EXIT TO MONITOR'
         M        NEWKEY,'NEWKEY','SET NEWKEY OPTION'
         M        ONEWKEY,'ONEWKEY','SET ONEWKEY OPTION'
         M        SETSN,'SETSN','SET SERIAL NUMBER(S)'
         M        SETPUB,'RSN','TURN SNS OFF'
         M        DELREC,'DELREC','DELETE RECORD'
         M        SETKEY,'SETKEY','SET KEY FOR DELREC OR READ/WRITE'
         M        SETARS,'SETARS','SET SIZE FOR READ/WRITE'
         M        DELTA,'DELTA','ASSOCIATE DELTA'
         M        NO%DELT,'NODELTA','DISASSOCIATE DELTA'
         M        IGNRLD,'LDOFF','SET TO IGNORE LOST DATA'
         M        DIGNRLD,'LDON','SET NOT TO IGNORE LOST DATA'
         M        SETAPE,'SLTAPE','SET LABELED TAPE'
         M        EOFON,'EOFON','SET NOT TO IGNORE END OF FILE'
         M        EOFOFF,'EOFOFF','SET TO IGNORE END OF FILE'
         M        SETDTAPE,'SDTAPE','SET DEVICE TAPE'
         M        SETFILE,'SFILE','SET FILE'
         M        PFNAME,'PFNAM','PRINT DCB FILE NAME'
         M        PKEY,'PKEY','PRINT DCB KEY BUFFER'
         M        PKEYHEX,'PKEYH','PRINT KEY IN HEX'
         M        PBLOCK,'PBLOCK','PRINT BLOCK # IN DECIMAL'
         M        PARS,'PARS','PRINT ARS IN DECIMAL'
         M        PRWS,'PRWS','PRINT RWS IN DECIMAL'
         M        PACCT,'PACCT','PRINT DCB ACCOUNT NO'
         M        PDCB,'PDCB','SNAP DCB'
         M        PRACCT,'PRACCT','PRINT RUNNING ACCOUNT','BO'
         M        PSN,'PSN','PRINT SN IN OPEN FPT'
         M        BUFOUT,'PBUF','SNAP I/O BUFFER'
         M        CBUFOUT,'PCBUF','SNAP COMPARE BUFFER'
         M        LOTOLP,'LOTOLP','OPENS M:LO TO LP'
         M        LOTOME,'LOTOME','OPENS M:LO TO ME','B'
         M        SETANS,'ANSSN','SET ANS, PROMPT FOR SNS'
         M        CONCAT,'CONCAT','SET CONCAT IN OPN PLIST'
         M        ABCERR,'ABCERR','SET TO IGNORE BLKCNT ERROR'
         M        CVOL,'CVOL','EXPLICIT SWITCH VOL'
         M        CLSPTL,'PTL','SET PTL OPTION FOR CLOSE'
         M        CLS%REM,'REM','SET REM OPTION FOR CLOSE'
         M        READL,'READL','READ WITH ULBL SPECIFIED'
         M        POPT,'POPT','PRINT OPTION'
         M        ERR%OPT,'SERROP','SET ERROR OPTION-QUIT,GO,ERROR'
         M        RERR%OPT,'RERROP','RESET ERROR OPTION'
         M        SCOMP,'SCOMP','SET COMPARE MODE FOR READS'
         M        RCOMP,'RCOMP','RESET COMPARE MODE FOR READS'
         M        PFPARAM,'PFPRAM','PRINT FPARAM AREA'
         M        R%OPEN,'ROPEN','RESET OPEN FPT'
         M        RSCLS%,'RCLOSE','RESET CLOSE FPT'
         M        SET%CYL,'SCYL','SET CYLINDER OPTION'
         M        RSET%CYL,'RCYL','RESET CYL OPTION'
         M        SET%NOSEP,'SNOSEP','SET NOSEP'
         M        RSET%NOSEP,'RNOSEP','RESET NOSEP'
         M        SNEWX,'SNEWX','SET SLIDES AND CONSEC'
         M        SCDUMP,'SCDUMP','DUMP BUFFERS IF COMPARE ERROR'
         M        RCDUMP,'RCDUMP','DONT DUMP BUFFERS IF COMPARE ERROR'
         M        COMMENT,'COMMENT','PRINT A COMMENT'
         M        TRUNC,'TRUNC','TRUNCATE DCB BUFFERS'
         M        WAIT%A%WHILE,'WAIT','WAIT FOR A WHILE'
         M        SRSOURCE,'SETRES','SET RESOURCE TYPE--2 CHAR'
         M        FRESOURCE,'RELRES','RELEASE RESOURCE TYPE--2 CHAR'
         M        TIME,'TIME','PRINT TIME AND DATE'
         M        GDDL,'GDDL','GET DYNAMIC LIMITS'
         M        GETPAGE,'GP','GET SPECIFIED NUMBER OF PAGES'
         M        FREPAGE,'FP','FREE SPECIFIED NUMBER OF PAGES'
         M        READAM,'READAM','READ ASSIGN MERGE RECORD'
         M        WRITEAM,'WRITEAM','WRITE ASSIGN MERGE RECORD'
         M        PRINT%IT,'PRINT','ISSUE SUPER-CLOSE'
         M        GHOST,'GJOB','INITIATE GHOST JOB'
         M        READLOG,'READLOG','READ ERROR LOG'
         M        WRITELOG,'WRITELOG','WRITE ERROR LOG'
         M        MASTER,'MASTER','ENTER MASTER MODE'
         M        WEOF%,'WEOF','WRITE END OF FILE'
         M        TSTABN,'TSTABN','NEXT CAL SHOULD ABORT WITH CODE'
         M        MESSG,'MESS','SEND MESSAGE TO OPERATOR'
         M        WAIT,'FILER','NOP FOR BATCH'
         M        LIST,'LIST','LIST OPTIONS'
         M        HELPONE,'HELP1','WHAT DOES THAT DO'
         M        LINK,'LINK','M:LINK TO LMN ACCT PSWD'
         M        LDTRC,'LDTRC','M:LDTRC TO (8) OR N A P'
         USECT    OPTS
NUMOPTS  EQU      %-OPTS
         USECT    WAIT
         PAGE
LIST     LI,6     -9
         LW,10    *%                MAKE BIR FLAG
HELP     LI,7     NUMOPTS
         LW,4     =X'80000000'
         STW,4    IBUF+17
HELP1    LI,3     NUMOPTS
         LW,4     =X'50000000'
         LW,2     OPTS-1,3
         LW,8     0,2
         LW,9     1,2
         CD,8     IBUF+17
         BLE      HELP2
         CD,8     4
         BG       HELP2
         LD,4     8
         LW,1     2
HELP2    BDR,3    HELP1+2
         STD,4    IBUF+17
         BIR,10   LIST1
         AI,1     -1
         BAL,15   MSG
HELP3    BDR,7    HELP1
         BIR,10   LIST2
         B        WAIT
LIST1    STD,4    IBUF+19,6
         BIR,6    HELP3
         LI,6     -9
         LI,1     IBUF+1
         LI,2     72
         CAL1,1   WRITELO
         B        HELP3
LIST2    AI,6     9
         BEZ      WAIT
         SLS,6    3
         LI,1     IBUF+1
         LW,2     6
         CAL1,1   WRITELO
         B        WAIT
HMSG     TC       'WHICH1'
HELPONE  SMSGT    HMSG
         BAL,10   GET8
         AI,1     0
         BE       WAIT
         LI,3     NUMOPTS
         LD,4     TBUF
         LW,1     OPTS-1,3
         CW,4     0,1
         BNE      %+3
         CW,5     1,1
         BE       HELPTWO
         BDR,3    %-5
         LW,1     14                RESTORE TEXT COUNT
         MI,1     -8                MAKE SHIFT VALUE
         LI,5     -1                AND MASK
         AI,1     32
         BLZ      HELPONE
         SLS,5    0,1
         LI,6     NUMOPTS
HELPTRE  LW,1     OPTS-1,6
         LCI      2
         LM,2     0,1
HELPFOR  CS,4     2
         BNE      %+3
         AI,1     -1
         BAL,15   MSG
         SLD,2    8
         AI,2     0
         BNE      HELPFOR
         BDR,6    HELPTRE
         B        HELPONE
HELPTWO  AI,1     -1
         BAL,15   MSG
         B        HELPONE
*
         SREF     GOQUIES
QUIES    LI,11    GOQUIES
         BEZ      WAIT
         BAL,11   GOQUIES
         B        WAIT
*
SRACCT   BAL,10   GET8
         LD,2     TBUF
         LCI      2
         STM,2    JIT+1
         B        WAIT
*
*
ERR%OPT  EQU      %
         SMSGI    ERR%MESS
         CI,1     2
         BLE      ERR%OPT%OK
         B        QNM
ERR%OPT%OK EQU    %
         STW,1    ERROPT
         LW,1     =X'02000000'
         STS,1    TEST%TYPE
         B        WAIT
RERR%OPT EQU      %
         LI,0     0
         LW,1     =X'02000000'
         STS,0    TEST%TYPE
         B        WAIT
ERR%MESS TC       'QUIT=0*GO=1*ERR=2'
SET%CYL  EQU      %
         LW,1     =X'00200000'
         STS,1    OPNFPT
         B        WAIT
RSET%CYL EQU      %
         LI,0     0
         LW,1     =X'00200000'
         STS,0    OPNFPT
         B        WAIT
SET%NOSEP EQU     %
         LW,1     =X'00400000'
         STS,1    OPNFPT
         B        WAIT
RSET%NOSEP EQU    %
         LI,0     0
         LW,1     =X'00400000'
         STS,0    OPNFPT
         B        WAIT
R%OPEN   EQU      %
         LI,2     BA(DEFAULT%OPN)
         LW,3     DEFAULT%TO%OPN
         MBS,2    0
         B        WAIT
RSCLS%   EQU      %
         LCI      3
         LM,2     CLSFPT%DEFAULT
         LCI      3
         STM,2    CLSFPT
         B        WAIT
SCDUMP   EQU      %
         LW,1     =X'00800000'
         STS,1    TEST%TYPE
         B        WAIT
RCDUMP   EQU      %
         LI,0     0
         LW,1     =X'00800000'
         STS,0    TEST%TYPE
         B        WAIT
EOFON    EQU      %
         LI,1     0
STORE%EOF EQU     %
         STW,1    EOFFLG1
         STW,1    EOFFLG2
         B        WAIT
EOFOFF   EQU      %
         LI,1     1
         B        STORE%EOF
COMMENT  EQU      %
         LW,7     BLKS              ZAP 'ENT'
         STW,7    IBUF+1
         B        MESSG+1
TRUNC    CAL,1    TRUNC%FPT
         B        WAIT
TRUNC%FPT GEN,8,24,32 18,MEI,0
WAIT%A%WHILE EQU  %
         SMSGI    HOW%LONG
         LW,0     1
         LW,1     =X'00FFFFFF'
         STS,0    WAITFPT
         CAL1,8   WAITFPT
         B        WAIT
WAITFPT  DATA     X'F000001'
HOW%LONG TC       '# OF 1.2 SECOND INCREMENTS'
SCOMP    EQU      %
         LW,1     =X'04000000'
         STS,1    TEST%TYPE
         B        WAIT
RCOMP    EQU      %
         LI,0     0
         LW,1     =X'04000000'
         STS,0    TEST%TYPE
         B        WAIT
READSI   FPT      16,M:SI
         DATA     X'F0000000',SCAN%ABN,SCAN%ABN,IBUF
         PZE      *3
         SREF     JIT
GET8     LI,1     8
GETNT    LI,2     TBUF
GETN     LI,3     81
         LB,4     TEST%TYPE
         CI,4     1
         BANZ     SCAN%REC
         LI,3     0
         STW,3    CARD%PRESENT
         LW,3     1
*
SCAN%REC EQU      %                 GET NEXT OPTION
         LW,13    CARD%PRESENT
         BNEZ     CARD%HERE
GET%CARD EQU      %
         CAL1,1   READSI
         LW,12    M:SI+4
         SLS,12   -17
         LW,13    =BA(IBUF)
         STB,12   13
CARD%HERE EQU     %
         LW,12    SCAN%FOR%OPTION
         TTBS,12  0
         BCR,1    GET%CARD
         LC       12
         BCS,4    GET%CARD
         STCF     OPT%TYP
         LW,15    13
         LW,14    SCAN%FOR%SEP
         TTBS,14  0
         BCS,1    %+2
         LI,15    0
         STW,15   CARD%PRESENT
         LI,12    X'7FFFF'
         AND,12   13
         LB,14    13
         LB,15    15
         SW,14    15
         BEZ      SET%ZERO%LEN
         CW,14    1
         BL       %+2
         LW,14    1
         LW,13    2
         SLS,13   +2
         CI,1     1                 IF ODD SIZE, SET TEXTC FORMAT
         BAZ      %+3
         STB,14   *2
         AI,13    1
         LW,15    13
         STB,14   13
         MBS,12   0
         CW,14    1
         BGE      TEST%PRINT%OPT
         LW,12    1
         SW,12    14
         STW,13   1
         STB,12   1
         MBS,0    BA(BLKS)
         STW,14   1
         B        TEST%PRINT%OPT
SET%ZERO%LEN EQU  %
         MTW,1    CARD%PRESENT
         MTB,-1   CARD%PRESENT
         LI,1     0
         B        *10
*
SCAN%ABN EQU      %
         LB,12    10
         CI,12    X'06'
         BE       EXIT
         CI,12    X'05'
         BNE      ERRJOB
EXIT     CAL1,9   1
*
TEST%PRINT%OPT EQU %
         LB,12    TEST%TYPE
         CI,12    8
         BAZ      *10
         STB,1    O%BUF
         LW,12    15
         LW,13    =BA(O%BUF)+1
         STB,1    13
         MBS,12   0
         LCI      3
         STM,1    IOREGS
         SMSG     O%BUF
         LCI      3
         LM,1     IOREGS
         B        *10
CARD%PRESENT DATA  0
SCAN%FOR%SEP DATA X'01000000'+BA(SCAN%TABLE)
SCAN%FOR%OPTION DATA X'C2000000'+BA(SCAN%TABLE)
OPT%TYP  DATA     0
SCAN%TABLE EQU    %
*        X'01'    SEPARATOR
*        X'02'    OPTION CHARACTR
*        X'03'    SEPARATOR + OPTION CHARACTER
*        X'40'    CARD TERMINATOR
*        X'83'    SEPARATOR + OPTION CHARACTER + SPECIAL CONDITION CODES
         DO1      3
         DATA     X'01010101'
         DATA     X'01030101'       CR
         DATA     X'01010101'
         DATA     X'01030101'       NL
         DO1      12
         DATA     X'01010101'
         DATA     X'01010140'       .
         DO1      3
         DATA     X'01010101'
         DATA     X'01010102'       %
         DATA     X'83010101'       *
         DATA     X'02030101'       -/
         DO1      5
         DATA     X'01010101'
         DATA     X'01010201'       :
         DO1      17
         DATA     X'01010101'
         DATA     X'01020202'       ABC
         DATA     X'02020202'       DEFG
         DATA     X'02020101'       HI
         DATA     X'01010101'
         DATA     X'01020202'       JKL
         DATA     X'02020202'       MNOP
         DATA     X'02020101'       QR
         DATA     X'01010101'
         DATA     X'01010202'       ST
         DATA     X'02020202'       UVWX
         DATA     X'02020101'       YZ
         DATA     X'01010101'
         DO1      2
         DATA     X'02020202'       01234567
         DATA     X'02020101'       89
         DATA     X'01010101'
*
BUFEND   MTW,0    *BUFSIZ,6
SETCBUF  EQU      %
         LW,6     CBUFFER
         B        SETBUF10
SETBUF   EQU      %
         LW,6     BUFFER
         ANLZ,7   BUFEND
         AI,7     -8-1
         STW,7    WHICH%BUF
SETBUF10 LI,1     32                GET 8 WORDS AT A TIME
         LW,2     6                 SET BUFFER ADDRESS
         BAL,10   GETN
         BE       WAIT
         AI,1     3                 ROUND UP
         SLS,1    -2
         AW,6     1                 INCR BUFF ADDRESS
         CW,6     WHICH%BUF
         BLE      SETBUF10
         LW,1     WHICH%BUF
         AI,1     9
         SW,1     6                 - BUFFER ADDRESS
         BLEZ     WAIT              YIELDS SIZE
         SLS,1    2                 TURN INTO # BYTES
         B        SETBUF10          GO READ MORE
*
SETCBUFD EQU      %
         LW,6     CBUFFER
         B        %+2
SETBUFD  EQU      %
         LW,6     BUFFER
         LW,7     BUFSIZ            # WORDS TO SET
SETD10   BAL,15   DECVALX
         B        %+2               NORMAL RETURN
         B        WAIT              ZERO LENGHT => GET OUT
         STW,1    *6
         AI,6     1
         BDR,7    SETD10
         B        WAIT
*
SETCBUFH EQU      %
         LW,6     CBUFFER
         B        %+2
SETBUFH  EQU      %
         LW,6     BUFFER
         LW,7     BUFSIZ
SETH10   BAL,15   HEXVALX
         B        %+2
         B        WAIT
         STW,1    *6
         AI,6     1
         BDR,7    SETH10
         B        WAIT
*
HEXVALX  STW,15   HEXRET
         LCI      15
         STCF     HEXRET
         B        HEX10
HEXVAL   STW,15   HEXRET
HEX10    EQU      %
         LI,10    0
         STW,10   HEXCOUNT
HEXVAL10 BAL,10   GET8
         LW,2     1
         BEZ      HEXCK
         AI,1     1
         SLS,1    -1
         STW,1    HEXCOUNT
         LI,1     0                 ZERO THE ANSWER
         LI,3     0
HEX15    SLS,1    4
         LB,4     TBUF,3            GET THE CHARACTER
         CLM,4    NUMS              IS IT A NUMBER
         BCS,9    HEX20             NOT A NUMBER
         AND,4    =X'F'             A NUMBER
         B        HEX30
HEX20    CLM,4    ALPHS             A LETTER MAYBE
         BCS,9    HEXER             ERROR, NOT ALETTER EITHER
         AI,4     -'A'+10           CONVER TO BIN
HEX30    AW,1     4
         AI,3     1
         BDR,2    HEX15
         B        *HEXRET
HEXER    BAL,15   QNMR
         B        HEXVAL10
HEXCK    LCF      HEXRET
         BCR,15   *HEXRET
         MTW,1    HEXRET
         B        *HEXRET
HEXRET   RES      1
HEXCOUNT DATA     0
         BOUND    8
NUMS     DATA     '0','9'
ALPHS    DATA     'A','F'
*
PCFPT    FPT      X'2C',':'
INTFPT   FPT      14,BREAKRTN
SETPMT   EQU      %
         STW,8    LNKRTN            SAVE RETURN
         CAL1,1   PCFPT
         CAL1,8   INTFPT
         LI,2     BA(OPNFPT)
         LW,3     OPN%TO%DEFAULT
         MBS,2    0
J:JIT    EQU      X'8C00'
         LC       J:JIT
         BCS,12   ON%LINE           GHOST OR ONLINE
         LW,1     =X'80000000'
         STS,1    TEST%TYPE
         BAL,15   SET%TEST%TYPE
         LI,1     M:LO
         CAL1,1   OPNLO
         LI,1     121               SET SNAP SIZE
         STW,1    SNAPSIZE
GETBUF   CAL1,8   GPFPT
         STW,9    BUFFER
         STW,9    CBUFFER
         B        BUFSIZER
*
ON%LINE  EQU      %
         LW,1     =X'40000000'
         STS,1    TEST%TYPE
         LI,15    OPN%EO
         LI,1     X'F'
         AND,1    M:SI
         CI,1     1
         BE       SET%TEST%TYPE
         LI,1     M:SI
         CAL1,1   OPNLOME
OPN%EO   EQU      %
         LI,1     M:LO
         CAL1,1   OPNLOME
         B        GETBUF
*
SET%TEST%TYPE EQU %
         LW,1     =X'01000000'
         STS,1    TEST%TYPE
         B        *15
*
BREAKRTN EQU      %
         LC       TEST%TYPE
         BCS,8    TRTRTN
         LI,8     CHKERR
         XW,8     0,1
         STW,8    10,1
TRTRTN   CAL1,9   5                 RETURN TO PROGRAM
         PAGE
IOMSG    LCI      0
         STM,0    IOREGS
         LH,3     10
         SLS,3    -1
         LW,8     15
         CH,3     TESTCODE
         STW,3    TESTCODE
         BE       WAIT
         LI,1     #IGNORS
         CH,3     IGNORS,1
         BE       IOMSG05
         BDR,1    %-2
         B        IOMSG09
IOMSG05  MTW,0    IGNORFLGS,1
         BNEZ     IOHAND,1
IOMSG09  LI,1     BA(IOTXT)+9
         LW,3     10
         LI,4     2
         BAL,15   HEXTODEC1
         AI,1     1
         SLS,3    -1
         LI,4     2
         BAL,15   HEXTODEC1
         LW,2     8
         AND,2    =X'1FFFF'
         AI,2     -1                POINT TO LABEL
         LI,7     #ERRS
         CW,2     ERRTAB,7
         BE       IOMSG10
         BDR,7    %-2
         B        IOMSG15
*
IOMSG10  LI,3     BA(IOTXT)+14
         LI,2     BA(ONM)
         LW,1     STARTNUMBER
         SW,1     NUMBERWRITES
         AI,1     1
         BAL,14   DECOUT0
         LB,1     0,5
         AI,5     -1
         LB,4     0,5
         AI,4     -'1'
         BEZ      %+3
         LI,4     3
         CB,1     HEXCHARS,4
         BE       %+2
         BDR,4    %-2
         SLS,4    1
         AI,5     2
         MTB,2    5
         MBS,4    BA(ORDS)
         LW,4     MSGTAB,7
         LB,1     0,4
         STB,1    5
         MBS,4    1
         LW,1     5
IOMSG15  LH,2     10
         SLS,2    -1
         LI,3     #ERRS1
         CH,2     ERRTAB1,3
         BE       IOMSG20
         BDR,3    %-2
         B        IOMSG22
*
IOMSG20  LW,2     MSGTAB1,3
         LB,3     0,2
         AI,2     1
         LB,4     0,2
         STB,4    0,1
         AI,1     1
         BDR,3    %-4
IOMSG22  AI,1     -BA(IOTXT)-1
         STB,1    IOTXT
         SMSG     IOTXT
IOMSG22A EQU      %
         LW,1     TEST%TYPE
         CW,1     =X'02000000'
         BAZ      IOMSG23
         LW,1     ERROPT
         B        %+1,1
         B        WAIT              QUIT
         B        IOMSG27           GO
ERRJOB   EQU      %
         CAL1,9   2                 ERROR
*
IOMSG23  EQU      %
         SMSGT    QUITMSG
IOMSG25  BAL,10   GET8
         LW,1     TBUF
         CW,1     ='GO  '
         BNE      IOMSG30
IOMSG27  LCI      0
         LM,0     IOREGS
         B        *8
IOMSG30  CW,1     ='QUIT'
         BE       WAIT
         CW,1     ='ERR '
         BE       ERRJOB
         BAL,15   QNMR
         B        IOMSG25
*
QUITMSG  TC       'QUIT/GO/ERR/'
ERROPT   DATA     0                 0=QUIT 1 = GO
IOTXT    TEXTC    'I/O ERR XX/YY'
         RES      20
         USECT    OPTS
ERRTAB   EQU      %-1
         USECT    OPTJMP
MSGTAB   EQU      %-1
         USECT    WAIT
         ERLC     WRITE51,' WRITE'
         ERLC     READ10,' READ'
         USECT    ERRTAB
#ERRS    EQU      %-ERRTAB-1
         USECT    WAIT
*
HEXTODEC LI,4     8
HEXTODEC1 LI,2    0
         SLD,2    4
         LB,2     HEXCHARS,2
         STB,2    0,1
         AI,1     1
         BDR,4    HEXTODEC1
         B        *15
*
HEXCHARS TEXT     '0123456789ABCDEF'
ORDS     TEXT     'THSTNDRD'
ONM      TEXTC    ' ON '
IOREGS   RES      16
         DEF      IOREGS
         USECT    OPTJMP
MSGTAB1  RES      1
         USECT    OPTS
ERRTAB1  RES,2    1
         USECT    WAIT
         ER       1,11,' CAN''T ALOCATE RANDOM'
         ER       2,0,' EOF ON NEXTF'
         ER       3,0,' NO FILE'
         ER       X'13',0,' NO SUCH KEY'
         ER       X'16',0,' KEY EXISTS'
         ER       X'18',0,' KEY TOO BIG'
         ER       5,0,' END OF DATA'
         ER       6,0,' END OF FILE'
         ER       7,0,' LOST DATA'
         ER       X'1C',0,' END OF TAPE'
         ER       X'1D',0,' BEGINNING OF TAPE'
         ER       X'42',0,' BLOCK # TOO BIG'
         ER       X'43',0,' KEY DOESN''T EXIST'
         ER       X'A9',0,' ERROR ON READ OF A/M RECORD'
         ER       X'4A',0,' BUFFER OUTSIDE USER PROGRAM'
         USECT    OPTS
         BOUND    4
         USECT    OPTJMP
#ERRS1   EQU      %-MSGTAB1
         USECT    WAIT
*
IGNORS   RES,2    1
         ERCD     7,0
         ERCD     X'1C',0
         ERCD     X'05',0
         ERCD     X'06',0
         BOUND    4
IGNORFLGS EQU     %-1
IGLDATA  DATA     0
CVOLFLG  DATA     1
EOFFLG1  DATA     0
EOFFLG2  DATA     0
#IGNORS  EQU      %-IGNORFLGS-1
IOHAND   EQU      %-1
         B        IOMSG27
         B        CVOL
         B        WAIT
         B        WAIT
         PAGE
NEWKEY   LW,1     =X'08000020'
         STW,1    KEYFLG
         B        WAIT
*
ONEWKEY  LW,1     =X'08000040'
         B        NEWKEY+1
*
SETSN    EQU      %
         LW,1     BLKS
         STW,1    SN+2
         LI,7     -3
SETSN%10 EQU      %
         LI,2     SN+3
         AW,2     7
         LI,1     4
         BAL,10   GETN
         BE       SETSNA10
         BIR,7    SETSN%10
         B        SETSNA10
         BAL,10   GETN
         B        WAIT
*
SRSOURCE EQU      %
         LI,7     X'C4D7'
         LI,1     2
         BAL,10   GETNT
         CI,1     2
         BNE      RSOURCE%STORE
         LW,7     TBUF
         SLS,7    -16               RIGHT JUSTIFY
RSOURCE%STORE EQU %
         STW,7    RSOURCE
         B        WAIT
*
*FREE RESOURCES
FRESOURCE EQU     %
         LI,1     2                 READ 2 CHAR
         BAL,10   GETNT
         CI,1     2                 DID WE READ 2 CHAR
         BNE      QNM               ERROR
         LH,6     TBUF
         LI,7     X'FFFF'
         STS,6    RSOURCECAL        SAVE IN RESOURCE CAL
         SMSGI    HOWMANYTOFREE
         LW,8     1                 # TO RELEASE IN 8
         LCI      0                 RESET ALL CONDITION CODES
         CAL1,8   RSOURCECAL        EXECUTE CAL
         BCS,8    EXCEEDED
         BCS,4    ODDCORE
         BCS,2    INVALIDRS
         B        WAIT
EXCEEDED EQU      %
         SMSG     EXCEEDRS
         B        WAIT
ODDCORE  EQU      %
         SMSG     ODDCORERS
         B        WAIT
INVALIDRS EQU     %
         SMSG     INVALIDRSMESS
         B        WAIT
HOWMANYTOFREE TC  '# TO FREE(D)'
EXCEEDRS TC       'EXCEEDED RESOURCE AUTHORIZED'
ODDCORERS TC      'CORE MUST BE EVEN # PAGES'
INVALIDRSMESS TC  'INVALID RESOURCE TYPE'
RSOURCECAL DATA   X'15000000'
*
TIME     EQU      %
         CAL1,8   TIMEFPT           GET TIME AND DATE
         LI,3     16
         STB,3    TBUF
         LI,2     BA(TBUF+1)
         SLS,3    24                RIGHT JUSTIFY COUNT
         AI,3     BA(TBUF)+1
         MBS,2    0
         SMSG     TBUF              PRINT TIME AND DATE
         B        WAIT
TIMEFPT  FPT      16,TBUF+1
*
GDDL     EQU      %
         CAL,8    GDDLFPT
         LI,2     BA(NOPAGESAVAIL)
         STW,10   NOPAGES
         LW,1     10
         BAL,15   DECOUT
         B        WAIT
*
GDDLFPT  FPT      27
NOPAGESAVAIL TC   'PAGES AVAILABLE = '
NOPAGES  DATA     255
CURPAGES DATA     0
*
FREPAGE  EQU      %
         SMSGI    HOWMANYP
         LC       OPT%TYP
         BCR,8    %+2
         LW,1     CURPAGES
         LW,2     1
         LI,3     X'1FFFF'
         STS,2    FPFPT
         CAL,8    FPFPT
         LCW,8    8
BUFSIZER AWM,8    CURPAGES
         SLS,8    8
         AWM,8    CBUFFER
         AWM,8    BUFSIZ
         SLS,8    1
         AWM,8    BUFSIZ2
         B        WAIT
FPFPT    FPT      9
*
GETPAGE  EQU      %
         SMSGI    HOWMANYP
         LC       OPT%TYP
         BCR,8    %+2
         LW,1     NOPAGES
         LW,2     1
         LI,3     X'1FFFF'
         STS,2    GPFPT
         CAL,8    GPFPT
         SMSG     GOTTENPAGEMSG
         LI,1     BA(O%BUF)+1
         LI,4     2
         STB,8    3
         BAL,15   HEXTODEC1
         LB,3     BLKS
         STB,3    0,1
         AI,1     1
         LW,3     9
         STW,9    DYNAMIC
         BAL,15   HEXTODEC
         LI,1     11
         STB,1    O%BUF
         SMSG     O%BUF
         B        BUFSIZER
HOWMANYP TC       '# PAGES(D),(*=ALL)'
GPFPT    FPT      8,4
*
GOTTENPAGEMSG TC  '# PAGES/ ADDR (HEX)'
*
DYNAMIC  DATA     0
*
*
READAM   CAL,1    AMR%FPT
         B        WAIT
*
AMR%FPT  DATA     X'2D000000'+MEI
         DATA     X'30000000'
         PZE      *BUFFER
         DATA     512*4
*
PRINT%IT EQU      %
         CAL,9    6                 SUPER CLOSE
         B        WAIT
*
GHOST    EQU      %
         SMSGT    GHOST%NAME
         LI,2     GJ%FPT+1
         LI,1     7
         BAL,10   GETN
         BE       WAIT
         CAL,6    GJ%FPT
         BCS,X'C' GHOSTERR
         B        WAIT
*
GHOSTERR EQU      %
         SMSG     GJ%ERRMSG
         B        WAIT
*
GJ%FPT   EQU      %
         DATA     X'06000000'
         DATA     0,0
*
GHOST%NAME TC     'NAME OF GHOST'
*
GJ%ERRMSG TC      'GJOB ERR'
*
WRITEAM  CAL,1    AMW%FPT
         B        WAIT
*
AMW%FPT  DATA     X'2E000000'+MEI
         DATA     X'30000000'
         PZE      *BUFFER
         DATA     512*4
*
MASTER   CAL,6    MAST%FPT
         BCR,8    WAIT
         SMSG     MAST%MSG
         B        WAIT
*
MAST%FPT DATA     X'08000000'
*
MAST%MSG TC       'INSUFFICIENT PRIVILIGE'
*
READLOG  CAL,6    BUFFER
         BCR,15   WAIT
         SMSG     READLGERR
         B        WAIT
*
READLGERR TC      'ERROR LOG READ FAILURE'
*
WRITELOG MTB,1    BUFFER            MAKE WRITE CAL
         CAL,6    BUFFER
         BCR,15   WAIT
         SMSG     WRITLGERR
         B        WAIT
*
WRITLGERR TC      'ERROR LOG WRITE FAILURE'
*
WEOF%    EQU      %
         CAL,1    WEOF%FPT
         B        WAIT
*
WEOF%FPT FPT      2,MEI
*
SETPUB   LI,0     0
         LI,1     X'FF00'
         STS,0    SN-1
         B        WAIT
*
SETANS   EQU      %
         LI,1     X'D4E3'
         STW,1    RSOURCE
         LI,2     3
         LI,1     5                 ANS FPT
         STB,1    OPNFPT+1,2
SETSNA   LI,7     -3                MAX SN
         LI,1     6
         BAL,10   GETNT
         CI,1     0                 CR HIT ?
         BE       SETSNA10
         LI,1     BA(TBUF)
         BAL,10   SIXPACK
         STW,2    SN+3,7
         BIR,7    SETSNA+1
SETSNA10 LI,5     3
         AW,7     5
         LI,5     2
         STB,7    SN-1,5
         B        WAIT
*
SIXPACK  LI,5     0
         LI,4     6
SIXPACK1 LB,3     0,1
         AI,1     1
         SLS,3    26
         SLD,2    2
         SLS,3    -28
         MI,5     10
         AW,5     3
         BDR,4    SIXPACK1
         SLS,2    20
         OR,2     5
         B        *10
*
CONCAT   LI,1     X'5000'
         LI,0     X'4000'           TURN ON CONCAT, RSTOR OFF
         STS,0    OPNFPT+1
         SMSGT    NOVOL
         B        SRSTOR
*
NOVOL    TC       'NUMBER OF VOLUMES'
*
ABCERR   LI,1     1
         SLS,1    20
         STS,1    OPNFPT
         B        WAIT
*
DELREC   LI,2     X'80'
         LI,1     X'30'
         AND,1    MEI+5
         CI,1     X'20'
         BE       %+2
         LI,2     0
         STB,2    DELFPT+1
DELC     CAL,1    DELFPT
         B        WAIT
*
DELFPT   FPT      X'D',MEI
         DATA     0
         DATA     KEYBUF
*
SETKEY   EQU      %
         BAL,15   WRITE10
         LC       KEY%COUNT         IF * IS SET
         BCS,8    WAIT
         AI,7     0
         BNEZ     WAIT
         MTB,-1   KEYRTN            NO INPUT, RESET SETKEYFLAG
         B        WAIT
*
DELTA    EQU      %
         LI,2     4
         STB,2    DELT%FPT
         CAL,4    DELT%FPT
         B        WAIT
*
DELT%FPT DATA     X'04020000'+%+3
         DATA     X'05C4C5D3'
         TEXT     'TA  '
         DATA     DELG,DELP,WAIT,0
DELG     BAL,15   DELL
         LW,3     0,3
DELP     BAL,15   DELL
         STS,0    0,3
DELL     CW,3     BUFSIZ2
         BGE      %+2
         AW,3     BUFFER
         EXU      *15
         LCI      0
         B        0,4
*
NO%DELT  EQU      %
         LI,2     5
         STB,2    DELT%FPT
         CAL,4    DELT%FPT
         CAL1,8   INTFPT
         B        WAIT
IGNRLD   LI,1     1
         STW,1    IGLDATA
         B        WAIT
*
DIGNRLD  LI,1     0
         B        IGNRLD+1
*
SETAPE   EQU      %
         LI,1     2
         LI,2     X'D4E3'
SET%OPN%FPT EQU   %
         STW,2    RSOURCE
         LI,2     3
         STB,1    OPNFPT+1,2
         B        WAIT
SETDTAPE EQU      %
         LI,1     3
         B        SETAPE+1
*
SETFILE  EQU      %
         LI,2     X'C4D7'
         LI,1     1
         B        SET%OPN%FPT
*
WHICH%BUF DATA    0
FPARAM   RES      90
         DEF      FPARAM
TLABEL   RES      80
         ORG      TLABEL
         GEN,32   X'50E4E3D3'
         TEXT     '1 TEST LABEL'
BUFSIZ   DATA     0
BUFSIZ2  DATA     0
BUFFER   DATA     0
CBUFFER  DATA     0
M:BO     DSECT    2
MEI      EQU      M:BO
         DATA     1,0,X'A000000',IOMSG,IOMSG
         DATA     0,MEI+22,0,0,0,MEIKBF
         DATA     0,0,0,0,0,0,0,0,0,0,0
         FPT      1,8
         RES      8
         FPT      2,2
         RES      2
         FPT      3,2
         RES      2
         FPT      7,3
         RES      3
         FPT      11,X'10008'
         RES      8
MEIKBF   RES      8
         USECT    WAIT
         END      SETPMT
