*M*      SHOW     DISPLAY :USERS AND ASSIGN/MERGE INFORMATION
         PCC      0
         SYSTEM   BPM
         SYSTEM   SIG7
         CSECT    0
FLAGS    DATA     0
FL:ALL   DATA     0
FL:DCBS  DATA     0
FL:USER  DATA     0
FL:PRIV  DATA     0
FL:PROC  DATA     0
FL:DFLT  DATA     0
PRTBUF   DATA     '    '
         DO1      24
         DATA     '    '
SAVEREG  RES      16
SAVER    RES      6
:USERS   RES      1
TEMPCTR  DATA     0
DISP     DATA     0
ADCBUF   DATA     '    '
         DO1      35
         DATA     '    '
AMRBUF   RES      512
AMRBFSZ  EQU      2048
NXTPTR   RES      1
PRTCTR   RES      1
DFLAG    DATA     0
VFLAG    DATA     0
ANSFLG   DATA     0
FILEBUF  RES      8
FILBFCTR DATA     0
TEMPBUF  RES      25
PATCH    RES      50
X1FE00   DATA     X'0001FE00'
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
         REF      J:JIT             BATCH OR ON-LINE USER?
         REF      JOPT              TERMINAL OPTIONS DISPLAY
         REF      J:TELFLGS         TEL FLAGS
         REF      M:LO              OUTPUT
         REF      J:CCBUF           COMMAND LINE INPUT
         REF      M:EI              USED TO READ ASSIGN/MERGE RECORD
         REF,1    JB:BCP            FIND :USERS COMMON PAGE
         REF      COCLN             GET COC LINE # FROM M:UC
         REF      M:UC              GET COC LINE # FROM M:UC
         REF      PRDCRM            CALC. RAD SPACE ACCUMULATED
         REF      PRDPRM            CALC. DISK SPACE ACCUMULATED
         REF      SV:LIM            NUMBER OF SERVICE LIMIT NAMES
         REF      SV:RSIZ           NUMBER OF RESOURCE LIMIT NAMES
         REF      SV:FTYM           NUMBER OF FEATURES AND PERIPHERALS
         REF      SL:EX             DEFAULT FOR DEFAULT FILE RETENTION
         REF      SL:MEX            DEFAULT FOR MAXIMUM FILE RETENTION
         REF      AM:XACC           DISPLACEMENT TO EXTENDED ACC. FIELD
         REF      AM:LNK            DISP. TO HEAD OF AM ASSIGN CHAIN
         DEF      SHOW
         DEF      PATCH
BLANKS   TEXT     '    '
FORHDR   TEXT     ';FORMAT='
FORCHR   DATA     '    '
ADRTAB   EQU      %-1
ODFADR   DATA     460
BDFADR   DATA     440
NAMEADR  DATA     480
RODFADR  DATA     424
RBDFADR  DATA     420
RNMADR   DATA     428
SYMTADR  DATA     412
SYMDB    DATA     410
SYMDO    DATA     411
         PAGE
*
* HEADERS - THESE ARE MESSAGES PRINTED BY SHOW
* USED FOR FORMATING THE INFORMATION REQUESTED BY THE USER
*
         CSECT    1
HEADERS  EQU      %
AUTOHDR  TEXT     'AUTOCALL PROCESSOR='
RDALLHDR TEXT     'READ = ALL'
RDNONEHDR TEXT    'READ = NONE'
RECLHDR  TEXT     ';RECL='
TRIESHDR TEXT     ';TRIES='
PRVHDR1  TEXT     'PRIVILEGE:'
PRVHDR2  TEXT     'BATCH   ON-LINE'
MSLHDR   TEXT     'MAXIMUM SERVICE LIMITS:'
BOLHDR1  TEXT     '            BATCH     ON-LINE'
BOLHDR3  TEXT     '       BATCH  ON-LINE'
MRLHDR   TEXT     'MAXIMUM RESOURCE LIMITS:'
ACSPHDR  TEXT     'ACCUMULATED SPACE:RAD='
DFRHDR   TEXT     'DEFAULT FILE RETENTION='
HOURS    TEXT     ' HOURS  '
MFRHDR   TEXT     'MAXIMUM FILE RETENTION='
DISKHDR  TEXT     ',  DISK='
PERLMHDR TEXT 'PERIPHERAL AND FEATURE AUTHORIZATION:'
DCBHDR   TEXT     'DCB ASSIGNMENTS:'
CYLHDR   TEXT     ';CYLINDER'
NOSEPHDR TEXT     ';NOSEP'
CONSCHDR TEXT     ';CONSEC'
KEYDHDR  TEXT     ';KEYED'
RNDMHDR  TEXT     ';RANDOM'
SEQENHDR TEXT     ';SEQUEN'
DRCTHDR  TEXT     ';DIRECT'
INHDR    TEXT     ';IN'
OUTHDR   TEXT     ';OUT'
INOUTHDR TEXT     ';INOUT'
OUTINHDR TEXT     ';OUTIN'
RELHDR   TEXT     ';REL'
SAVEHDR  TEXT     ';SAVE'
RSTRHDR  TEXT     ';RSTORE='
EXPHDR   TEXT     ';EXPIRE='
TABHDR   TEXT     ';TAB'
SEQHDR   TEXT     ';SEQ='
DATAHDR  TEXT     ';DATA='
LINESHDR TEXT     ';LINES='
QCNTHDR  TEXT     ';COUNT='
SPCEHDR  TEXT     ';SPACE='
DRCHDR   TEXT     ';DRC'
NODRCHDR TEXT     ';NODRC'
BINHDR   TEXT     ';BIN'
BCDHDR   TEXT     ';BCD'
PACKHDR  TEXT     ';PACK'
UNPCKHDR TEXT     ';UNPACK'
FBCDHDR  TEXT     ';FBCD'
NFBCDHDR TEXT     ';NOFBCD'
VFCHDR   TEXT     ';VFC'
NOVFCHDR TEXT     ';NOVFC'
LHDR     TEXT     ';L'
NOLHDR   TEXT     ';NOL'
ABCHDR   TEXT     ';ABCERR'
SHRHDR   TEXT     ',SHARE'
EXCLHDR  TEXT     ',EXCL'
KEYMHDR  TEXT     ';KEYM='
VOLHDR   TEXT     ';VOL='
NEWXHDR  TEXT     ';NEWX='
SPAREHDR TEXT     ';SPARE='
CONCATHD TEXT     ';CONCAT='
BLKLHDR  TEXT     ';BLKL='
LRECLHDR TEXT     ';LRECL='
D16HDR   TEXT     ';DEN=1600'
D8HDR    TEXT     ';DEN=800'
EBCHDR   TEXT     ';EBC'
ASCHDR   TEXT     ';ASC'
SNHDR    TEXT     ';SN='
RDHDR    TEXT     ';READ='
WRHDR    TEXT     ';WRITE='
EXHDR    TEXT     ';EXECUTE='
UNDHDR   TEXT     ';UNDER='
EXTACHDR TEXT     'EXTENDED ACCOUNTING INFORMATION:'
NASNHDR  TEXT     ' IS NOT ASSIGNED'
BDOPTHDR TEXT     ' IS NOT A VALID OPTION'
LNNUMHDR TEXT     'USER ID=       COC LINE=    '
NODFHDR  TEXT     'CANT GIVE YOU SYSTEM DEFAULT VALUES'
PROCHDR  TEXT     'ON-LINE PROCESSOR OPTIONS:'
INDEFHDR TEXT     'RETAINED INDEFINITELY'
OUTPHDR  TEXT     'DONT OUTPUT'
COMHDR   TEXT     'DONT COMMENT'
DBUGHDR  TEXT     'DONT DEBUG'
SENDHDR  TEXT     'DONT SEND'
LISTHDR  TEXT     'DONT LIST'
ERRORHDR TEXT     'DONT ERROR'
FORTBL   DATA     ' FDV','U   '
RAMR     EQU      %
         GEN,8,7,17 X'2D',0,M:EI
         GEN,8,24   X'30',0
         DATA     AMRBUF
         DATA     AMRBFSZ
SENDFPT  DATA     X'06600000'
         PAGE
*************************************************************************
*
*P*      NAME:    SHOW
*P*
*P*      PURPOSE: SHOW IS A PROCESSOR THAT CAN BE CALLED EITHER
*P*      ON-LINE OR BATCH TO DISPLAY CERTAIN INFORMATION ABOUT THE
*P*      USER AND HIS DCB ASSIGNMENTS.
*P*
*P*      DESCRIPTION: ON-LINE SHOW IS CALLED BY A SHOW COMMAND TO
*P*      TEL. THE SHOW COMMAND CANNOT EXCEED FIFTY CHARACTERS AND
*P*      HAS THE FORM:
*P*           !SHOW   OPTION,OPTION,OPTION,...
*P*      THE LEGAL OPTIONS ARE:
*P*           USER - DISPLAYS
*P*                  ACCOUNT,NAME
*P*                  READ=ALL OR NONE
*P*                  AUTOCALL PROCESSOR=PROCESSOR NAME(IF ONE EXISTS)
*P*                  USER ID= XX, COC LINE= XX
*P*                  ACCUMULATED SPACE:RAD= XXX,DISK= XXX
*P*           PRIV - DISPLAYS
*P*                  DEFAULT FILE RETENTION= XXX HOURS
*P*                  MAXIMUM FILE RETENTION= XXX HOURS
*P*                  EXTENDED ACCOUNTING INFORMATION:
*P*                            XXXXXXXX
*P*                  PRIVILEGE:
*P*                     BATCH   ON-LINE
*P*                       XX      XX
*P*                  MAXIMUM SERVICE LIMITS
*P*                         BATCH   ON-LINE
*P*                  SERV     XX      XX
*P*                  MAXIMUM RESOURCE LIMITS
*P*                         BATCH   ON-LINE
*P*                  RES      XX      XX
*P*                  PERIPHERAL AND FEATURE AUTHORIZATION
*P*                         BATCH   ON-LINE
*P*                  PER. DEV XX      XX
*P*                  FEATURE  XX      XX         XX= YES OR NO
*P*           PROC - DISPLAYS THE SETTING OF THE TERMINAL OPTIONS
*P*                  LIST,SEND,OUTPUT,COMMENT AND DEBUG.
*P*           DCBS - DISPLAYS IN SET COMMAND FORMAT THE USERS CURRENT
*P*                  DCB ASSIGNMENTS
*P*           M:?? OR F:?? - DISPLAYS IN SET COMMAND FORMAT THE CURRENT
*P*                  ASSIGNMENT FOR THE REQUESTED DCB ONLY
*P*           ALL  - DISPLAYS ALL OF THE ABOVE INFORMATION AND IS THE
*P*                  DEFAULT IF NO OPTIONS ARE SPECIFIED
*P*
*P*      SHOW CAN BE CALLED BY A BATCH PROGRAM BY A !SHOW CARD. THE
*P*      OPTION FIELD OF THE CARD IS IGNORED AND THE USER AND PRIV
*P*      OPTIONS ARE ASSUMED. SHOW IS CALLED BY CCI IF A JOB IS
*P*      ABORTED FOR EXCEEDING A LIMIT.
*
******************************************************************************
*
*F*      NAME:    SHOW
*F*
*F*      DESCRIPTION: SHOW WILL DISPLAY TO THE USER INFORMATION FROM
*F*      HIS :USERS RECORD, JIT, ASSIGN/MERGE RECORD, AND IF HE HAS
*F*      AT LEAST X'80' PRIVILEGE THE TABLES OF DEFAULT LIMITS IN THE
*F*      MONITOR ROOT.
*F*           WHEN TEL OR CCI SEES THAT SHOW IS BEING CALLED THEY
*F*      GET A COMMON PAGE AND READ THE USERS RECORD FROM THE :USERS
*F*      FILE INTO IT - IMMEDIATELY BLANKING OUT THE PASSWORD. WHEN
*F*      SHOW IS ENTERED IT CALCULATES THE LAST COMMON PAGE OBTAINED
*F*      FROM JB:BCP AND LOOKS THERE FOR THE :USERS INFORMATION.
*F*           THE JIT AND ASSIGN MERGE RECORD ARE USED TO CALCULATE
*F*      THE ACCUMULATED FILE SPACE FOR THE USER, THE EXTENDED
*F*      ACCOUNTING INFORMATION IS TAKEN FROM THE A/M RECORD. THE
*F*      LIMIT AND AUTHORIZATION INFORMATION IS TAKEN FROM THE :USERS
*F*      RECORD FOR ALL ITEMS WHICH ARE THERE - AND IF THE USER HAS
*F*      SUFFICIENT PRIVILEGE THE DEFAULT VALUES ARE DISPLAYED FROM
*F*      LOW CORE. THE DCB ASSIGNMENTS COME FROM THE A/M RECORD AND ARE
*F*      DISPLAYED ONLY FOR THE ONLINE USER. OUTPUT IS THROUGH M:UC
*F*      FOR ONLINE USERS AND M:LO FOR BATCH USERS.
******************************************************************************
         PAGE
**************************************************************************
*
*D*      NAME:  SHOW'S-COMMON-PAGE
*D*
*D*      CCI AND TEL PASS SHOW A COMMON PAGE IN WHICH THEY HAVE PUT
*D*   THE :USERS RECORD FOR THE LOGON NAME,ACCOUNT AND THE TABLES
*D*   OF DEFAULT SERVICE, RESOURCE, AND PERIPHERAL AUTHORIZATION
*D*   IF POSSIBLE. THE FORMAT OF THIS PAGE IS:
*D*
*D*               --------------------------------------------
*D*      WD 0     |
*D*               |
*D*      THRU     |       :USERS RECORD
*D*               |
*D*      WD 125   |
*D*               |
*D*               |
*D*      WD 410   |     S:SYMDB
*D*      WD 411   |     S:SYMDO
*D*      WD 412   |     SH:SYMT
*D*               |
*D*               |
*D*      WD 420   |     SB:RBMX
*D*               |
*D*      WD 424   |     SB:RODF
*D*               |
*D*      WD 428   |     SH:RNM
*D*               |
*D*               |
*D*      WD 440   |     SL:BMX
*D*               |
*D*               |
*D*               |
*D*      WD 460   |     SL:ODF
*D*               |
*D*               |
*D*               |
*D*      WD 480   |     SL:NAME
*D*               |
*D*               |
*D*      WD 500   |     FLAG 0 => NO DEFAULT TABLES IN PAGE - ELSE OK
*D*               |
*D*               ----------------------------------------------
************************************************************************
         PAGE
SHOW     EQU      %
         CAL1,1   RAMR
*
* GT:USERS - WILL GET THE ADRESS OF THE COMMON PAGE THAT TEL HAS
* READ THE :USERS RECORD INTO FRON JB:BCP - SHIFT IT TO GET THE
* WORD ADDRESS - LOAD THAT ADDRESS INTO :USERS SO THAT IT CAN
* BE USED TO INDIRECTLY ADRESS THE :USERS RECORD
*
GT:USERS EQU      %
         LI,R1    JB:BCP
         LB,R2    0,R1
         AI,R2    1
         SLS,R2   9
         STW,R2   :USERS
OPT      LI,R7    0
         LI,R1    0
OPT1     LB,R2    J:CCBUF,R1
         STB,R2   R8,R7
         LI,R6    TERMSIZ
         CB,R2    TERMTBL,R6
         BE       OPTPROC
         BDR,R6   %-2
         AI,R7    1
         AI,R1    1
OPT1A    CI,R1    79
         BLE      OPT1
         LI,R6    2
OPTPROC  LC       J:JIT
         BCS,8    OPTPROC1          ONLINE
         CW,R8    ='SHOW'           BATCH - TEST FOR CALLED BY ABORT
         BE       OPTPROC1          NO - NORMAL CALL BY !SHOW CARD
         MTW,1    FL:PRIV           YES - J:CCBUF NOT SET UP
         B        EVALOPT           SHOW PRIV INFO
OPTPROC1 CI,R6    3
         BGE      PROC1
         CI,R7    0
         BNE      PROC2
         SLS,R8   8
         CW,R8    =X'C8D6E600'
         BNE      EVALOPT
         MTW,1    FL:ALL
         B        EVALOPT
PROC2    CW,R8    ='SHOW'
         BNE      PROC3
         CI,R6    3
         BGE      RET1
         MTW,1    FL:ALL
         B        EVALOPT
PROC3    CW,R8    ='USER'
         BNE      PROC4
         MTW,1    FL:USER
         B        RETURN
PROC4    CW,R8    ='PRIV'
         BNE      PROC5
         MTW,1    FL:PRIV
         B        RETURN
PROC5    CW,R8    ='DCBS'
         BNE      PROC6
         MTW,1    FL:DCBS
         B        RETURN
PROC6    CW,R8    ='PROC'
         BNE      PROC7
         MTW,1    FL:PROC
         B        RETURN
PROC7    LW,R5    R8
         SLS,R5   -8
         CW,R5    =X'00C1D3D3'
         BNE      DCBHUNT
         MTW,1    FL:ALL
RETURN   CI,R6    3
         BL       EVALOPT
RET1     LI,R7    0
         AI,R1    1
         B        OPT1
PROC1    CI,R7    0
         BNE      PROC2
         AI,R1    1
         B        OPT1A
DCBHUNT  SLS,R5   -8
         CI,R5    'M:'
         BE       GOTDCB
         CI,R5    'F:'
         BNE      BADOPT
GOTDCB   LI,R5    BA(ADCBUF)
         LW,R4    DISP
         AW,R5    R4
         STB,R7   0,R5              STORE COUNT
         AI,R5    1
         LI,R4    X'20'             BA(R8)
         STB,R7   R5
         MBS,R4   0
         LI,R4    12
         AWM,R4   DISP
         B        RETURN
BADOPT   LI,R4    X'20'             BA(R8)
         LI,R5    BA(PRTBUF)
         STB,R7   R5
         MBS,R4   0
         LI,R4    BA(BDOPTHDR)
         LI,R3    24
         STB,R3   R5
         MBS,R4   0
         BAL,R8   PRINTER
         B        RETURN
TERMTBL  DATA     X'00150D6B'
         DATA     X'40000000'
TERMSIZ  EQU      4
*
* EVALOPT WILL TEST TO SEE WHICH FLAGS ARE SET AND WILL GET
* THE NECESSARY INFORMATION FROM THE *:USERS FILE FOR THE
* ALL, USER AND PRIV OPTIONS. IT FORMATS THE INFORMATION
* USING THE HEADERS AND BALS TO THE PRINTER VIA R8.
*
EVALOPT  EQU      %
         LW,R1    FL:ALL
         AW,R1    FL:USER
         BNEZ     USER
         AW,R1    FL:PRIV
         BNEZ     ACSPACE           GO PRINT FILE INFO
         AW,R1    FL:PROC
         BNEZ     PROCOPT
         B        DCBINFO
USER     LW,R1    :USERS
         LI,R2    0
         LI,R4    0
USER0    LB,R3    *R1,R2
         CI,R3    ' '
         BE       USER1
         STB,R3   PRTBUF,R4
         AI,R4    1
         AI,R2    1
         CI,R2    7
         BLE      USER0
USER1    LI,R3    ','
         STB,R3   PRTBUF,R4
         AI,R4    1
         AI,R1    2
         LI,R2    0
USER2    LB,R3    *R1,R2
         CI,R3    ' '
         BE       USER3
         STB,R3   PRTBUF,R4
         AI,R4    1
         AI,R2    1
         CI,R2    11
         BLE      USER2
USER3    BAL,R8   PRINTER
         LI,R2    5
         LW,R1    *:USERS,R2
         BLZ      NONE
         LCI      3
         LM,R0    RDALLHDR
         STM,R0   PRTBUF
         B        NONE1
NONE     LCI      3
         LM,0     RDNONEHDR
         STM,R0   PRTBUF
NONE1    BAL,R8   PRINTER
AUTOCALL EQU      %                 GET AUTOCALL PROC. NAME
         LI,R3    12
         MTW,0    *:USERS,R3        SEE IF AUTOCALL EXISTS
         BEZ      LINENUM
         LW,R2    :USERS
         AI,R2    12
         LB,R1    *R2
         SLS,R2   2                 BYTE ADRESS FOR MBS
         AI,R2    1                 SKIP COUNT
         LI,R3    BA(PRTBUF+5)
         STB,R1   R3                PUT COUNT IN R3
         MBS,R2   0                 MOVE IT
         LCI      5
         LM,R1    AUTOHDR           GET HEADER
         STM,R1   PRTBUF            STORE HEADER IN PRTBUF
         BAL,R8   PRINTER           GO PRINT IT
*
* LINENUM - WILL GET AND PRINT THE USER ID (SYSID) & COC LINE #
*
LINENUM  EQU      %
         MTW,0    J:JIT
         BLZ      %+2
         B        DEFIL
         LCI      7
         LM,R2    LNNUMHDR
         STM,R2   PRTBUF
         LI,R2    X'FF'
         AND,R2   M:UC+COCLN
         BAL,R8   BIN2HEX
         STW,R4   PRTBUF+6
         LI,R2    X'FFFF'
         AND,R2   J:JIT
         BAL,R8   BIN2HEX
         LW,R7    R4
         BAL,R8   BIN2HEX
         STH,R4   R7
         STW,R7   PRTBUF+2
         BAL,R8   PRINTER
*
* ACSPACE - GETS AND PRINTS THE ACCUMULATED SPACE ( BOTH RAD
* AND DISK ) THAT THE USER HAS AMMASSED.
*
ACSPACE  EQU      %
         LCI      6
         LM,R2    ACSPHDR           LOAD HEADER
         STM,R2   PRTBUF
         LI,R3    18
         LW,R3    *:USERS,R3
         AW,R3    AMRBUF+20
         SW,R3    J:JIT+PRDCRM
         BAL,R8   BIN2BCD
         BAL,R8   LZE
         CW,R6    ='    '
         BNE      %+4
         STW,R7   PRTBUF+6
         LI,R2    PRTBUF+7
         B        %+4
         LI,R2    PRTBUF+8
         LCI      2
         STM,R6   PRTBUF+6
         LCI      2
         LM,R4    DISKHDR
         STM,R4   *R2
         LI,R3    22
         LW,R3    *:USERS,R3
         AW,R3    AMRBUF+21
         SW,R3    J:JIT+PRDPRM
         BAL,R8   BIN2BCD
         BAL,R8   LZE
         AI,R2    2
         CW,R6    ='    '
         BNE      %+3
         STW,R7   *R2
         B        %+3
         LCI      2
         STM,R6   *R2
         BAL,R8   PRINTER           GO PRINT IT
*
* DEFILRET - GETS AND PRINTS THE DEFAULT FILE RETENTION PERIOD
*
DEFIL    MTW,0    FL:ALL
         BNE      %+3
         MTW,0    FL:PRIV
         BE       DCBINFO
         LW,R1    :USERS
         LW,R2    500,R1            ARE DFLTS THERE
         BNEZ     DFLTSOK           YES
NODFLTS  MTW,1    FL:DFLT
         LCI      9
         LM,R1    NODFHDR
         STM,R1   PRTBUF
         BAL,R8   PRINTER
         B        DEFILRET
DFLTSOK  LI,R2    9                 SET UP TABLE ADDRESSES
         AWM,R1   ADRTAB,R2
         BDR,R2   %-1
DEFILRET EQU      %
         LCI      6
         LM,R1    DFRHDR            LOAD HEADER
         STM,R1   PRTBUF
         LW,R2    :USERS
         AI,R2    20
         LH,R3    *R2
         AND,R3   =X'FFFF'
         LI,R1    MXFILRET
         LI,R4    SL:EX
FILRET1  CI,R3    0
         BNE      %+2
         LW,R3    R4
         CI,R3    X'FFFF'
         BNE      %+2
         B        INDEF
         BAL,R8   BIN2BCD
         BAL,R8   LZE
         CW,R6    ='    '
         BNE      FILRET2
         STW,R7   PRTBUF+6
         LCI      2
         LM,R6    HOURS
         STM,R6   PRTBUF+7
         B        FILRET3
FILRET2  LCI      2
         STM,R6   PRTBUF+6
         LM,R6    HOURS
         STM,R6   PRTBUF+8
FILRET3  BAL,R8   PRINTER
         B        *R1
*
* MXFILRET - GETS AND PRINTS THE MAXIMUM FILE RETENTION PERIOD
*
MXFILRET EQU      %
         LCI      6
         LM,R3    MFRHDR
         STM,R3   PRTBUF
         LI,R7    1
         LI,R3    1
         LH,R3    *R2,R3
         AND,R3   =X'FFFF'
         LI,R4    SL:MEX
         LI,R1    EXACINFO
         B        FILRET1
*
* INDEF - PRINTS 'RETAINED INDEFINITELY' IF FILE RETENTION IS X'FFFF'
*
INDEF    EQU      %
         LCI      6
         LM,R3    INDEFHDR
         STM,R3   PRTBUF+6
         BAL,R8   PRINTER
         B        *R1
*
* EXACINFO - GETS AND PRINTS THE EXTENDED ACCOUNTING INFORMATION
*
EXACINFO EQU      %
         LW,R1    AMRBUF+AM:XACC    IS EXACC FIELD THERE
         CW,R1    BLANKS            NOT IF BLANK
         BE       PRIV
         LCI      8
         LM,R1    EXTACHDR
         STM,R1   PRTBUF
         BAL,R8   PRINTER
         LCI      6
         LM,R1    AMRBUF+AM:XACC
         STM,R1   PRTBUF+2
         BAL,R8   PRINTER           GO PRINT IT
PRIV     EQU      %
         LB,R1    J:JIT
         BGEZ     MSL               BATCH
         LCI      3
         LM,R1    PRVHDR1
         STM,R1   PRTBUF
         BAL,R8   PRINTER
         LCI      4
         LM,R1    PRVHDR2
         STM,R1   PRTBUF
         BAL,R8   PRINTER
         LW,R1    :USERS
         AI,R1    16
         LB,R2    *R1
         BAL,R8   BIN2HEX
         STW,R4   PRTBUF
         LI,R2    1
         LB,R2    *R1,R2
         BAL,R8   BIN2HEX
         STW,R4   PRTBUF+2
         BAL,R8   PRINTER
MSL      EQU      %
         LCI      6
         LM,R1    MSLHDR
         STM,R1   PRTBUF
         BAL,R8   PRINTER
         LCI      8
         LM,R1    BOLHDR1
         STM,R1   PRTBUF
         BAL,R8   PRINTER
         LW,R0    :USERS
         AI,R0    30
         MTW,0    FL:DFLT
         BNEZ     MSL0
         LI,R4    SV:LIM
SERVLOOP LW,R5    *NAMEADR,R4
         LI,R1    15
TSTLOOP1 CW,R5    *R0,R1
         BE       NOTDFSRV
         BDR,R1   TSTLOOP1
         BAL,R2   DFLTSERV
NOTDFSRV BDR,R4   SERVLOOP
MSL0     LW,R4    :USERS
         AI,R4    46
         LW,R5    :USERS
         AI,R5    62
         LI,R1    15
MSL1     LW,R2    *R0,R1
         CW,R2    ='    '
         BE       MSL2
         CI,R2    0
         BE       MSL2
         STW,R2   PRTBUF
         LW,R3    *R4,R1
         BAL,R8   BIN2BCD
         BAL,R8   LZE
         LCI      2
         STM,R6   PRTBUF+2
         LW,R3    *R5,R1
         BAL,R8   BIN2BCD
         BAL,R8   LZE
         LCI      2
         STM,R6   PRTBUF+5
         BAL,R8   PRINTER
MSL2     BDR,R1   MSL1
MRL      EQU      %
         LCI      6
         LM,R1    MRLHDR
         STM,R1   PRTBUF
         BAL,R8   PRINTER
         LCI      8
         LM,R1    BOLHDR1
         STM,R1   PRTBUF
         BAL,R8   PRINTER
         LW,R0    :USERS
         AI,R0    94
         MTW,0    FL:DFLT
         BNEZ     MRL0
         LI,R4    SV:RSIZ
RESLOOP  LH,R5    *RNMADR,R4
         LI,R1    15
TSTLOOP2 CH,R5    *R0,R1
         BE       NOTDFRES
         BDR,R1   TSTLOOP2
         BAL,R2   DFLTRES
NOTDFRES BDR,R4   RESLOOP
MRL0     LW,R4    :USERS
         AI,R4    102
         LW,R5    :USERS
         AI,R5    106
         LI,R1    15
MRL1     LH,R2    *R0,R1
         CH,R2    =X'4040'
         BE       MRL2
         CI,R2    0
         BE       MRL2
         STH,R2   PRTBUF
         LB,R3    *R4,R1
         CI,R2    X'FC3D6'
         BNE      %+2
         SLS,R3   -1                CONVERT PAGES TO K
         BAL,R8   BIN2BCD
         BAL,R8   LZE
         LCI      2
         STM,R6   PRTBUF+2
         LB,R3    *R5,R1
         CI,R2    X'FC3D6'          IS IT CO
         BNE      %+2
         SLS,R3   -1                CONVERT PAGES TO K
         BAL,R8   BIN2BCD
         BAL,R8   LZE
         LCI      2
         STM,R6   PRTBUF+5
         BAL,R8   PRINTER
MRL2     BDR,R1   MRL1
PERLIM   EQU      %
         LCI      10
         LM,R1    PERLMHDR
         STM,R1   PRTBUF
         BAL,R8   PRINTER
         LCI      6
         LM,R1    BOLHDR3
         STM,R1   PRTBUF
         BAL,R8   PRINTER
         LW,R0    :USERS
         AI,R0    114
         MTW,0    FL:DFLT
         BNEZ     PERLIM0
         LI,R4    SV:FTYM
PERLOOP  LH,R5    *SYMTADR,R4
         LI,R1    15
TSTLOOP3 CH,R5    *R0,R1
         BE       NOTDFPER
         BDR,R1   TSTLOOP3
         BAL,R2   DFLTPER
NOTDFPER BDR,R4   PERLOOP
PERLIM0  LW,R3    :USERS
         AI,R3    122
         LI,R1    15
PERLIM1  LH,R2    *R0,R1
         CH,R2    =X'4040'
         BE       PERLIM6
         CI,R2    0
         BE       PERLIM6
         STH,R2   PRTBUF
         LB,R4    *R3,R1
         LI,R5    X'80'
         LI,R6    X'FF'
         CS,R4    R6
         BNE      PERLIM2
         LW,R7    ='YES '
         STW,R7   PRTBUF+2
         B        PERLIM3
PERLIM2  LW,R7    ='NO  '
         STW,R7   PRTBUF+2
PERLIM3  LI,R5    X'40'
         CS,R4    R6
         BNE      PERLIM4
         LW,R7    ='YES '
         STW,R7   PRTBUF+4
         B        PERLIM5
PERLIM4  LW,R7    ='NO  '
         STW,R7   PRTBUF+4
PERLIM5  BAL,R8   PRINTER
PERLIM6  BDR,R1   PERLIM1
         B        PROCOPT
DFLTSERV EQU      %
         STW,R5   PRTBUF
         LW,R3    *BDFADR,R4
         BAL,R8   BIN2BCD
         BAL,R8   LZE
         LCI      2
         STM,R6   PRTBUF+2
         LW,R3    *ODFADR,R4
         BAL,R8   BIN2BCD
         BAL,R8   LZE
         LCI      2
         STM,R6   PRTBUF+5
         BAL,R8   PRINTER
         B        *R2
DFLTRES  EQU      %
         STH,R5   PRTBUF
         LB,R3    *RBDFADR,R4
         BAL,R8   BIN2BCD
         BAL,R8   LZE
         STW,R7   PRTBUF+3
         LB,R3    *RODFADR,R4
         BAL,R8   BIN2BCD
         BAL,R8   LZE
         STW,R7   PRTBUF+6
         BAL,R8   PRINTER
         B        *R2
DFLTPER  EQU      %
         STH,R5   PRTBUF
         LW,R3    =X'80000000'
         LW,R5    R4
         SLS,R3   -1
         BDR,R5   %-1
         CS,R3    *SYMDB
         BNE      DFLTPER1
         LW,R7    ='YES '
         B        %+2
DFLTPER1 LW,R7    ='NO  '
         STW,R7   PRTBUF+2
         CS,R3    *SYMDO
         BNE      DFLTPER3
         LW,R7    ='YES '
         B        %+2
DFLTPER3 LM,R7    ='NO  '
         STW,R7   PRTBUF+4
         BAL,R8   PRINTER
         B        *R2
         PAGE
PROCOPT  LC       J:JIT
         BCR,8    DCBINFO           BATCH SKIP PROCOPT
         AW,R1    FL:ALL
         BEZ      DCBINFO
         LCI      7
         LM,R1    PROCHDR
         STM,R1   PRTBUF
         BAL,R8   PRINTER
         LW,R1    J:JIT+JOPT
         CI,R1    X'100'
         BAZ      DONTCOM
         LCI      2
         LM,R2    COMHDR+1
         SCD,R2   8
         LCI      2
         B        %+3
DONTCOM  LCI      3
         LM,R2    COMHDR
         STM,R2   PRTBUF+1
         BAL,R8   PRINTER
         CI,R1    X'10000'
         BAZ      DONTDBG
         LCI      2
         LM,R2    DBUGHDR+1
         SCD,R2   8
         LCI      2
         B        %+3
DONTDBG  LCI      3
         LM,R2    DBUGHDR
         STM,R2   PRTBUF+1
         BAL,R8   PRINTER
         CI,R1    X'1'
         BAZ      DONTLIST
         LCI      2
         LM,R2    LISTHDR+1
         SCD,R2   8
         LCI      2
         B        %+3
DONTLIST LCI      3
         LM,R2    LISTHDR
         STM,R2   PRTBUF+1
         BAL,R8   PRINTER
         CI,R1    X'80'
         BAZ      DONTOUTP
         LCI      2
         LM,R2    OUTPHDR+1
         SCD,R2   8
         LCI      2
         B        %+3
DONTOUTP LCI      3
         LM,R2    OUTPHDR
         STM,R2   PRTBUF+1
         BAL,R8   PRINTER
         CAL1,8   SENDFPT           CHECK MODE5 DEFER BIT
         LC       R11
         BCS,2    DONTSEND          X'20' BIT OF MODE5 IS DEFER
         LCI      2
         LM,R2    SENDHDR+1
         SCD,R2   8
         LCI      2
         B        %+3
DONTSEND LCI      3
         LM,R2    SENDHDR
         STM,R2   PRTBUF+1
         BAL,R8   PRINTER
         LW,R2    J:TELFLGS         GET TEL FLAGS
         CW,R2    =X'01000000'      SEE IF ERROR IS ON
         BAZ      DONTERROR         NO-->BRANCH
         LCI      2
         LM,R2    ERRORHDR+1
         SCD,R2   8
         LCI      2
         B        %+3
DONTERROR EQU     %
         LCI      3
         LM,R2    ERRORHDR
         STM,R2   PRTBUF+1
         BAL,R8   PRINTER
         B        DCBINFO
         PAGE
*
* PRINTER - WILL TAKE THE CONTENTS OF PRTBUF, DELETES
* TRAILING BLANKS, OUTPUTS A LINE OF PRINT AND RETURNS
* TO THE CALLING ROUTINE. COMMUNICATION IS VIA REGISTER 8.
*
PRINTER  EQU      %
         LCI      0
         STM,R0   SAVEREG           SAVE ALL REGISTERS
         LI,R1    99                SET CHARACTER POINTER
STEP1    LB,R2    PRTBUF,R1         GET CHARACTER
         CI,R2    ' '               TEST FOR BLANK
         BE       STEP2             IF BLANK GO TO STEP2
         B        STEP3             IF NOT GO TO STEP3
STEP2    AI,R1    -1                DECREMENT REGISTER 1
         BNEZ     STEP1
STEP3    LC       J:JIT
         BCR,8    STEP4             BATCH
         AI,R1    1
         LI,R3    X'15'             ADD LINE FEED
         STB,R3   PRTBUF,R1
         AI,R1    1
         M:WRITE  M:UC,(BUF,PRTBUF),(SIZE,*R1),(WAIT),(BTD,0)
         B        STEP5
STEP4    AI,R1    1
         M:WRITE  M:LO,(BUF,PRTBUF),(SIZE,*R1),(WAIT),(BTD,0)
STEP5    LW,R2    BLANKS            BLANK FILL PRTBUF
         LI,R1    24
         STW,R2   PRTBUF,R1
         BDR,R1   %-1
         STW,R2   PRTBUF
         LCI      0
         LM,R0    SAVEREG           RESTORE REGISTERS
         B        *R8               RETURN
         PAGE
*
* LZE - WILL SUBSTITUTE LEAD BLANKS FOR LEAD ZEROS
*
LZE      EQU      %
         LCI      6
         STM,R0   SAVEREG
         LI,R5    X'40'
         LW,R0    R6
         LW,R1    R7
         LI,R2    0
AGAIN    LB,R3    R0,R2
         CI,R3    X'F0'
         BNE      ENDLZE
         STB,R5   R6,R2
         AI,R2    1
         CI,R2    7
         BL       AGAIN
ENDLZE   LCI      6
         LM,R0    SAVEREG
         B        *R8
*
* BIN2BCD - WILL CONVERT A BINARY VALUE TO ITS PTINTABLE BCD VALUE
*
BIN2BCD  EQU      %
         LCI      6
         STM,R0   SAVER
         LI,R1    7
BINA     LI,R2    0
         DW,R2    =10
         AI,R2    X'F0'
         STB,R2   R6,R1
         AI,R1    -1
         BGEZ     BINA
         LCI      6
         LM,R0    SAVER
         B        *R8
         PAGE
*
* BIN2HEX - WILL CONVERT A BINARY BYTE TO ITS PRINTABLE
*HEXADECIMAL EQUIVALENT. R2 CONTAINS THE BINARY BYTE TO BE
*CONVERTED AND R4 CONTAINS THE CONVERTED HEX VALUE.
*
BIN2HEX  EQU      %
         LI,R5    3
         LW,R4    =X'40404040'      SET POINTER AND BLANK R4
GO       SLD,R2   -4                POSITION BYTE
         SLS,R3   -28
         CW,R3    =X'09'
         BG       BIG9              >9 GO TO BIG9
         OR,R3    =X'F0'
         B        OVER              CONVERT AND GO TO OVER
BIG9     SW,R3    =X'09'            SUBTRACT X'09'
         OR,R3    =X'C0'            CONVERT
OVER     STB,R3   R4,R5             STORE CONVERTED VALUE
         AI,R5    -1                DECREMENT POINTER
         CI,R5    1                 DONE?
         BG       GO                NOPE - RETURN
         B        *R8               YUP- RETURN TO CALLING ROUTINE
*
* LOADER - WILL TAKE THE INFORMATION SUPLIED IN THE BUFFERS
* SET TO HEADER AND COUNT AND MOVE IT TO TEMPBUF.
*
LOADER   EQU      %
         LW,R6    R13
         LI,R7    BA(TEMPBUF)
         AW,R7    TEMPCTR           SET UP SOURCE AND DEST.
         STB,R14  R7
         MBS,R6   0
         AW,R14   TEMPCTR
         STW,R14  TEMPCTR
         B        *R8
         PAGE
*
* DCBINFO - WILL READ THE ASSIGN - MERGE RECORD INTO A BUFFER
* AMRBUF AND WILL TEST TO SEE IF THE INFORMATION FOR EACH  DCB
* IN THE RECORD HAS BEEN REQUESTED EITHER BY THE ALL,DCBS OR
* INDIVIDUAL DCB OPTIONS. IF IT HAS IT BRANCHES TO START.
*
DCBINFO  EQU      %
         MTW,0    FL:ALL
         BNEZ     INFO1
         MTW,0    FL:DCBS
         BNEZ     INFO1
         LW,R7    ADCBUF
         CW,R7    BLANKS
         BNE      INFO1
         B        THEEND
INFO1    LCI      4
         LM,R3    DCBHDR
         STM,R3   PRTBUF
         BAL,R8   PRINTER
NXTDCB1  LW,R7    AMRBUF+AM:LNK     GET POINTER TO FIRST PLIST ENTRY
         BEZ      ENDER             NO DCBS ASSIGNED
NXTDCB   LI,R1    AMRBUF
         AW,R1    R7
         LW,R7    *R1               GET POINTER TO NEXT ENTRY
         STW,R7   NXTPTR            STORE IT
         AI,R1    1                 ADVANCE TO DCB NAME
         LB,R3    *R1               GET TEXTC COUNT OF DCBNAME
         LW,R0    R1
         SLS,R0   2
         AI,R3    1                 INCLUDE COUNT
         LI,R6    0
NXTADCB  LW,R4    R0
         LI,R5    BA(ADCBUF)
         AW,R5    R6
         STB,R3   R5
         CBS,R4   0
         BE       PRESTART
         AI,R6    12
         CI,R6    144
         BGE      TESTS
         B        NXTADCB
TESTS    MTW,0    FL:ALL
         BNEZ     START
         MTW,0    FL:DCBS
         BNEZ     START
         CI,R7    0                 TEST FOR LAST ENTRY
         BE       ENDER
         B        NXTDCB
*
* START - START WILL PUT THE WORD 'SET' AND THE DCB NAME IN
* PRTBUF, THEN IT WILL FIND THE FPT, TEST FOR THE CYLINDER
* AND NOSEP OPTIONS, SET FLAGS FOR THE V (VLP) AND D (DEVICE
* FPT) OPTINNS, AND SEARCH ALL THE PARAMETER PRESENCE
* BITS AND BRANCH TO THE PROPER ROUTINE IF THEY ARE SET.
*
PRESTART EQU      %
         SW,R5    R3                RESET TO CONDITION BEFORE CBS
         SLS,R5   -2
         LW,R4    BLANKS
         STW,R4   *R5
START1   LW,R4    R0
START    AI,R4    1                 SKIP COUNT
         LW,R0    ='SET '
         STW,R0   PRTBUF
         LI,R5    BA(PRTBUF)+4
         AI,R3    -1                SKIP COUNT
         STB,R3   R5
         MBS,R4   0
         AI,R3    1
         STW,R3   PRTCTR            ESTABLISH PRTCOUNTER
         MTW,4    PRTCTR
         LI,R3    1
FPTSRCH  LW,R4    *R1,R3
         LB,R4    R4
         CI,R4    X'14'
         BE       ENDSRCH
         AI,R3    1
         B        FPTSRCH
ENDSRCH  LW,R4    *R1,R3
         SLS,R4   10
         BEV      CYLIN             IF EVEN NOSEP NOT SET
         LI,R13   BA(NOSEPHDR)
         LI,R14   6
         BAL,R8   LOADER
CYLIN    SLS,R4   1                 TEST CYL BIT
         BEV      ABCERR
         LI,R13   BA(CYLHDR)
         LI,R14   9
         BAL,R8   LOADER
ABCERR   SLS,R4   1
         BEV      DVWORD
         LI,R13   BA(ABCHDR)
         LI,R14   7
         BAL,R8   LOADER
DVWORD   AI,R3    1                 GET SECOND WORD OF FPT
         LW,R4    *R1,R3
         CI,R4    X'4000'
         BAZ      DTST
         MTW,1    VFLAG
DTST     CI,R4    X'1000'
         BAZ      TPJR
         MTW,1    DFLAG
TPJR     AND,R4   =X'7'
         CI,R4    4
         BE       TPJR1
         CI,R4    5                 ANS TAPE
         BNE      PWORD
         LI,R4    'TA'
         MTW,1    ANSFLG
         B        TPJR2
TPJR1    LI,R4    'RJ'
TPJR2    LW,R5    PRTCTR
         STB,R4   PRTBUF,R5
         AI,R5    1
         SLS,R4   -8
         STB,R4   PRTBUF,R5
         MTW,2    PRTCTR
PWORD    AI,R3    1                 GET THIRD WORD OF FPT
         LW,R4    *R1,R3
         SLS,R4   3                 SKIP FIRST THREE BITS
         LI,R5    0
NXTBIT   AI,R5    1
         CI,R5    20                CHECK POINTER FOR DONE
         BE       VLPS
         SLS,R4   1                 TEST NEXT BIT
         BEV      NXTBIT
         AI,R3    1
         LW,R6    BTBL,R5
         LCI      0
         STM,R0   SAVEREG
         B        *R6
NXTBIT1  LCI      0
         LM,R0    SAVEREG
         B        NXTBIT
NXTBIT2  MTW,1    SAVEREG+3
         B        NXTBIT1
*
*BTBL - IS A TABLE TELLING START WHERE TO GO DEPENDING
* ON THE VALUE OF THE INDEX REGISTER = R5.
*
BTBL     EQU      %-1
         DATA     P4
         DATA     P5
         DATA     P6
         DATA     P7
         DATA     P8
         DATA     0,P10
         DATA     NXTBIT2
         DATA     NXTBIT2
         DATA     P13
         DATA     P14
         DATA     NXTBIT2
         DATA     P16
         DATA     P17
         DATA     P18
         DATA     NXTBIT2
         DATA     P20
         DATA     P21
         DATA     P22
*
* P4 - RECL OPTION SPECIFIED
*
P4       EQU      %
         MTW,0    ANSFLG            IF ANS BLKL ELSE RECL
         BNE      P4ANS
         LI,R13   BA(RECLHDR)
         LI,R14   6
         B        P20A
P4ANS    LI,R13   BA(BLKLHDR)
         LI,R14   6
         B        P20A
*
* P5 - TRIES OPTION WAS SPECIFIED
*
P5       LI,R13   BA(TRIESHDR)
         LI,R14   7
         B        P20A
*
* P6 - WILL BE CALLED IF THE ORG. PRESENCE BIT IS SET
*
P6       EQU      %
         LW,R4    *R1,R3
         MTW,0    ANSFLG
         BNE      FORMAT
         CI,R4    1
         BE       CONSEC
         CI,R4    2
         BE       KEYED
         LI,R13   BA(RNDMHDR)
         LI,R14   7
P6A      BAL,R8   LOADER
         B        NXTBIT1
KEYED    LI,R13   BA(KEYDHDR)
         LI,R14   6
         B        P6A
CONSEC   LI,R13   BA(CONSCHDR)
         LI,R14   7
         B        P6A
FORMAT   LB,R4    FORTBL,R4
         STB,R4   FORCHR
         LI,R13   BA(FORHDR)
         LI,R14   9
         B        P6A
*
* P7 - WILL BE CALLED IF THE ACCESS PRESENCE BIT IS SET
*
P7       EQU      %
         LW,R4    *R1,R3
        SLS,R4    30
        SLS,R4    1
        BEV       SEQUEN
        LI,R13    BA(DRCTHDR)
         LI,R14   7
         B        P6A
SEQUEN  LI,R13    BA(SEQENHDR)
         LI,R14   7
         B        P6A
*
* P8 - WILL BE CALLED WHEN THE MODE PRESENCE BIT IS SET
*
P8       EQU      %                 1=IN,2=OUT,4=INOUT,8=OUTIN
         LW,R4    *R1,R3
         CI,R4    8
         BAZ      INOUT
         LI,R13   BA(OUTINHDR)
         LI,R14   6
         B        P6A
INOUT    CI,R4    4
         BAZ      OUT
         LI,R13   BA(INOUTHDR)
         LI,R14   6
INOUT1   BAL,R8   LOADER
         CI,R4    X'200'
         BAZ      NXTBIT1
         CI,R4    X'100'
         BANZ     INSHARE
         LI,R13   BA(EXCLHDR)
         LI,R14   5
         B        P6A
INSHARE  LI,R13   BA(SHRHDR)
         LI,14    6
         B        P6A
OUT      CI,R4    2
         BAZ      IN
         LI,R13   BA(OUTHDR)
         LI,R14   4
         B        P6A
IN       LI,R13   BA(INHDR)
         LI,R14   3
         B        INOUT1
*
* P10 - WILL BE CALLED WHEN THE REL/SAVE PRESENCE BIT IS SET
*
P10      EQU      %                 1=REL,2=SAVE
         LW,R4    *R1,R3
         SLS,R4   31
         BEV      REL
         LI,R13   BA(SAVEHDR)
         LI,R14   5
         B        P6A
REL      LI,R13   BA(RELHDR)
         LI,R14   4
         B        P6A
*
* P13 - KEYM
P13      LI,R13   BA(KEYMHDR)
         LI,R14   6
         B        P20A
*
* P14 - WILL BE CALLED WHEN AN OPLABEL,TAPECODE, OR
* PACKCODE HAS BEEN SPECIFIED IN THE SET COMMAND
*
P14      EQU      %
         MTW,0    ANSFLG            ANS TAPE ALREADY DONE
         BNE      NXTBIT1
         LW,R4    *R1,R3
         SCS,R4   -8
         LI,R5    PRTBUF
         LW,R2    PRTCTR
         STB,R4   *R5,R2
         AI,R2    1
         SCS,R4   8
         STB,R4   *R5,R2
         MTW,2    PRTCTR
         B        NXTBIT1
*
* P16 - VOLUME
*
P16      LI,R13   BA(VOLHDR)
         LI,R14   5
         B        P20A
*
*P17 - NEWX,SLIDES,CONSECUTIVE SLIDES
*
P17      LI,13    BA(NEWXHDR)
         LI,R14   6
         BAL,R8   LOADER
         LW,R0    *R1,R3
         SLS,R0   16
         LB,R3    R0
         BAL,R9   P20B
         LI,R11   ','
         LI,R13   47
         LI,R14   1
         BAL,R8   LOADER
         SLS,R0   8
         LB,R3    R0
         LI,R9    NXTBIT1
         B        P20B
*
* P18 - SPARE=
*
P18      EQU      %
         MTW,0    ANSFLG            IF ANS CONCAT ELSE SPARE
         BNE      P18ANS
         LI,R13   BA(SPAREHDR)
         LI,R14   7
         B        P20A
P18ANS   LI,R13   BA(CONCATHD)
         LI,R14   8
         B        P20A
*
* P20 - WILL BE CALLED WHEN THE RSTORE OPTION IS SPECIFIED
*
P20      EQU      %
         MTW,0    ANSFLG            IF ANS LRECL ELSE RSTORE
         BNE      P20ANS
         LI,R13   BA(RSTRHDR)
         LI,R14   8
P20A     LI,R9    NXTBIT1
         BAL,R8   LOADER
         LW,R3    *R1,R3
P20B     BAL,R8   BIN2BCD
         LW,R11   R7
         LI,R13   44                44=BA(R11)
         LI,R14   4
         BAL,R8   LOADER
         B        *R9
P20ANS   LI,R13   BA(LRECLHDR)
         LI,R14   7
         B        P20A
*
* P21 - DENSITY
*
P21      LW,R3    *R1,R3
         CI,R3    1
         BE       DEN800
         LI,R13   BA(D16HDR)
         LI,R14   9
         B        P6A
DEN800   LI,R13   BA(D8HDR)
         LI,R14   8
         B        P6A
*
* P22 - ANSCII OR EBCDIC
*
P22      LW,R3    *R1,R3
         CI,R3    1
         BE       ASCII
         LI,R13   BA(EBCHDR)
P22A     LI,R14   4
         B        P6A
ASCII    LI,R13   BA(ASCHDR)
         B        P22A
*
* VLPS - WILL LOOK AT THE CONTROL WORD OF THE VLP AND BAL
* TO THE PRORER ROUTINE. IT ALSO SKIPS TO THE NEXT WHEN FINISHED.
*
VLPS     EQU      %
         MTW,0    VFLAG
         BEZ      DFPT
         AI,R3    1
RESTART  LW,R4    *R1,R3
         LB,R4    R4
         LI,R5    9
COMPARE  CB,R4    VTBL,R5
         BE       FOUND
         BDR,R5   COMPARE
         B        FOUND1
FOUND    LW,R5    VBTBL,R5
         LCI      0
         STM,R0   SAVEREG
         BAL,R9   *R5               GO TO PROPER SUBROUTINE
         LCI      0
         LM,R0    SAVEREG
FOUND1   LW,R4    *R1,R3            GET CONTROL WORD
         SLS,R4   8                 SHIFT TO LAST PARAMETER? BYTE
         LB,R5    R4
         AI,R3    1
         CI,R5    1                 TEST FOR LAST PARAMETER
         BE       DFPT
         SLS,R4   -8                SHIFT BACK
         AND,R4   =X'FF'            ZERO ALL BUT LENGTH BYTE
         AW,R3    R4                ADD TO WORD POINTER
         B        RESTART
*
* VTBL - IS A BYTE TABLE OF PARAMETER TYPE CODES.
*
VTBL     EQU      %
         DATA     X'00010203'
         DATA     X'04050607'
         DATA     X'14150000'
*
* VBTBL - IS A WORD TABLE OF WHERE VLPS SHOULD BAL TO.
*
VBTBL    EQU      %-1
         DATA     FILENAME
         DATA     PASSACCT
         DATA     PASSACCT
         DATA     EXPDATE
         DATA     RDACCT
         DATA     WRACCT
         DATA     SN
         DATA     EXACCT
         DATA     UNDERNM
*
* FILENAME - WILL GET THE FILENAME INTO FILEBUF AFTER A SLASH
*
FILENAME EQU      %
         AI,R3    1
         LI,R4    X'61'             SLASH
         STB,R4   FILEBUF
         MTW,1    FILBFCTR
         LW,R4    *R1,R3
         LB,R4    R4
%TEST    CI,R4    3
         BNE      NOT%
         LW,R6    *R1,R3
         SLS,R6   -8                USER ID IN RIGHT HALFWORD
         LI,R7    X'FFFF'
         CS,R6    J:JIT
         BNE      NOT%
         LI,R7    X'5B'             %
         LW,R6    PRTCTR
         AI,R6    1
         STB,R7   PRTBUF,R6
         BAL,R8   PRINTER
         B        FINAL1
NOT%     LW,R6    R1
         AW,R6    R3                SET UP SOURCE FOR MBS
         SLS,R6   2
         AI,R6    1
         LI,R7    BA(FILEBUF)+1     DESTINATION FOR MBS
         STB,R4   R7                COUNT FOR MBS
         MBS,R6   0
         AW,R4    FILBFCTR
         STW,R4   FILBFCTR
         B        *R9
*
* PASSACCT - WILL PUT BOTH THE ACCOUNT AND THE PASSWORD (IF
* THEY EXIST) INTO FILEBUF PRECEDED BY A PERIOD.
*
PASSACCT EQU      %
         LW,R2    *R1,R3            GET CONTROL WORD
         AND,R2   =X'FF'            GET LENGTH BYTE
         SLS,R2   2                 CONVERT FROM WORDS TO BYTES
         AI,R2    -1                SUTRACT ONE TO MAKE INDEX
         AI,R3    1                 GET FIRST WORD OF PASS-ACCT
         LW,R4    R1
         AW,R4    R3                SET UP BASE FOR INDEX & MBS
PATEST   LB,R5    *R4,R2
         CI,R5    X'40'             TEST FOR BLANK
         BNE      PAFILL            NOT BLANK - FOUND END OF P&A
         AI,R2    -1
         CI,R2    0                 TEST FOR NO P&A
         BL       *R9               RETURN IF NONE
         B        PATEST
PAFILL   LI,R6    X'4B'             PERIOD
         LI,R5    FILEBUF
         LW,R7    FILBFCTR
         STB,R6   *R5,R7
         MTW,1    FILBFCTR
         AI,R7    1
         AI,R2    1                 CONVERT INDEX TO COUNT
         LI,R5    BA(FILEBUF)
         AW,R5    R7
         STB,R2   R5
         SLS,R4   2
         MBS,R4   0
         AW,R2    FILBFCTR
         STW,R2   FILBFCTR
         B        *R9
*
* EXPDATE - WILL PUT THE EXPIRATION DATE, EITHER NEVER,DDD
* OR MM,DD,YY IN TEMPBUF AFTER THE HEADER ';EXPIRE='.
*
EXPDATE  AI,R3    1
         LI,R13   BA(EXPHDR)
         LI,R14   8
         BAL,R8   LOADER
         LCI      2
         LM,R10   *R1,R3
         LB,R4    R10
         CI,R4    'N'
         BE       NEVER
         CI,R4    ' '
         BE       DAYS
         SCD,R10  16
         SLS,R10  -8
         LI,R12   ','
         STB,R12  R10
         SCD,R10  -8
         STB,R12  R11
         SCD,R10  -8
         LI,R13   40                BA(R10)
         LI,R14   8
         BAL,R8   LOADER
         B        *R9
NEVER    LI,R14   5
         LI,R13   40
         BAL,R8   LOADER
         B        *R9
DAYS     LI,R14   3
         LI,R13   41
         BAL,R8   LOADER
         B        *R9
*
* SN - WILL PUT THE SERIAL NUMBER IN PRTBUF PRECEDED BY A '#'.
*
SN       EQU      %
         LW,R2    *R1,R3
         AND,R2   =X'FF'
         CI,R2    1
         BE       SN1
         LI,R13   BA(SNHDR)
         LI,R14   4
         BAL,R8   LOADER
         LI,R10   ' '
         B        %+2
SN0      LI,R10   ','
         AI,R3    1
         LW,R11   *R1,R3
         MTW,0    ANSFLG
         BE       SN0A
         LW,R4    R11
         BAL,R0   SIXBACK
         LW,R11   R12
         LW,R12   R13
         LI,R13   43
         LI,R14   7
         B        SN0B
SN0A     LI,R13   43
         LI,R14   5
SN0B     BAL,R8   LOADER
         BDR,R2   SN0
         B        *R9
SN1      AI,R3    1
         LI,R2    X'7B'             '#'
         LI,R4    PRTBUF
         LW,R7    PRTCTR
         STB,R2   *R4,R7
         MTW,1    PRTCTR
         LW,R4    *R1,R3
         MTW,0    ANSFLG
         BE       SN1A
         BAL,R0   SIXBACK
         LD,R4    R12
         LI,R2    6
         B        SN1B
SN1A     LI,R2    4
SN1B     LW,R7    PRTCTR
         LI,R6    16                BA(R4)
         AI,R7    BA(PRTBUF)
         STB,R2   R7
         MBS,R6   0
         AW,R2    PRTCTR
         STW,R2   PRTCTR
         B        *R9
         B        *R9
*
* RD,WR,EX ACCT - DO READ WRITE AND EXECUTE ACCOUNTS
*
RDACCT   LI,R13   BA(RDHDR)
         LI,R14   6
         B        RDWREX
WRACCT   LI,R13   BA(WRHDR)
         LI,R14   7
         B        RDWREX
EXACCT   LI,R13   BA(EXHDR)
         LI,R14   9
RDWREX   BAL,R8   LOADER
         LW,R2    *R1,R3
         AND,R2   =X'FF'
         AI,R3    1
         LI,R10   ' '
         B        %+2
RDWREX1  LI,R10   ','
         LCI      2
         LM,R11   *R1,R3
         LI,R6    0
         LI,R14   1
RDWREX2  LB,R13   R11,R6
         CI,R13   ' '
         BE       RDWREX3
         AI,R6    1
         AI,R14   1
         CI,R6    7
         BLE      RDWREX2
RDWREX3  LI,R13   43                BA(R10)+3
         BAL,R8   LOADER
         AI,R3    2
         AI,R2    -2
         BGZ      RDWREX1
         B        *R9
*
* UNDERNM - OUTPUT UNDER PROCESSOR NAME
*
UNDERNM  LI,R13   BA(UNDHDR)
         LI,R14   7
         BAL,R8   LOADER
         AI,R3    1
         LCI      3
         LM,R10   *R1,R3
         LB,R14   R10               GET BYTE COUNT
         LI,R13   41                BA(R10)+1
         BAL,R8   LOADER
         B        *R9
*
* SIXBACK - CONVERT ANS HASHED SN TO SIX CHAR
*
SIXBACK  SLD,R4   -20
         SLS,R5   -12
         LW,R7    R5
         LI,R8    6
SIXBACK1 SLD,R4   -2
         SLS,R5   -26
         LI,R6    0
         DW,R6    =X'A'
         OR,R5    R6
         BEZ      %+2
         AI,R5    X'80'
         AI,R5    X'40'
         SLD,R12  -8
         STB,R5   R12
         BDR,R8   SIXBACK1
         B        *R0
*
* DFPT - WILL SEARCH THE Q PRESENCE BITS AND BRANCH TO THE
* PROPER SUBROUTINE IF SET.
*
DFPT     EQU      %
         MTW,0    DFLAG
         BEZ      FINAL
         AI,R3    1
         LW,R4    *R1,R3
         LI,R5    0
NXTQBIT  AI,R5    1
         CI,R5    9                 TEST POINTER FOR DONE
         BE       FINAL
         SLS,R4   1                 SHIFT ONE PRESENCE BIT OFF LEFT
         BEV      NXTQBIT           EVEN = 0 - NOT PRESENT
         LW,R6    QTBL,R5
         BAL,R9   *R6
         B        NXTQBIT           AFTER COMPLETION TRY NEXT BIT
*
* QTBL - IS THE TABLE THAT TELLS DFPT WHERE TO GO.
*
QTBL     EQU      %-1
         DATA     TABS
         DATA     SEQ
         DATA     DATA
         DATA     QCOUNT
         DATA     NXTQBIT           SHOULD NEVER BE SET
         DATA     LINES
         DATA     SPACE
         DATA     Q8
*
* TABS - SEARCHES THE FOUR WORDS OF POSSIBLE TAB POSITIONS,
* AND PUTS EACH ONE THAT EXISTS IN TEMPBUF AFTER 'TABS='.
*
TABS     EQU      %
         LCI      0
         STM,R0   SAVEREG
         LI,R13   BA(TABHDR)
         LI,R14   4
         BAL,R8   LOADER
         LW,R4    R1
         AW,R4    R3
         AI,R4    1
         LI,R5    -1
NXTTAB   AI,R5    1
         LB,R3    *R4,R5
         CI,R5    17                TEST FOR DONE
         BGE      ENDTABS
         CI,R3    0                 TEST FOR NO MORE TABS
         BE       ENDTABS
TABFILL  CI,R5    0                 FIRST TAB?
         BE       EQUSIN            YES - GET =
         LI,R10   X'6B'             NO - GET ,
         B        ENDSIN
EQUSIN   LI,R10   X'7E'
ENDSIN   BAL,R8   BIN2BCD           CONVERT TAB
         STB,R10  R7                PUT IN SEPERATOR
         LW,R11   R7
         LI,R13   44                44=BA(R11)
         LI,R14   4
         BAL,R8   LOADER
         B        NXTTAB
ENDTABS  LCI      0
         LM,R0    SAVEREG
         AI,R3    4
         B        *R9
*
* SEQ - GETS THE SEQ HEADER AND VALUE INTO TEMPBUF
*
SEQ      EQU      %
         AI,R3    1
         LW,R11   *R1,R3
         LI,R13   BA(SEQHDR)
         LI,R14   5
         BAL,R8   LOADER
         LI,R13   44                44=BA(R11)
         LI,R14   4
         BAL,R8   LOADER
         B        *R9
*
* DATA - GETS THE DATA HEADER AND CONVERTED VALUE INTO TEMPBUF
*
DATA     EQU      %
         LI,R13   BA(DATAHDR)
         LI,R14   6
         BAL,R8   LOADER
VALUE    AI,R3    1
         LW,R15   R3
         LW,R3    *R1,R3
         BAL,R8   BIN2BCD
         LW,R11   R7
         LI,R13   44                44=BA(R11)
         LI,R14   4
         BAL,R8   LOADER
         LW,R3    R15
         B        *R9
*
* LINES - GETS THE LINES HEADER AND CONVERTED VALUE INTO TEMPBUF
*
LINES    EQU      %
         LI,R13   BA(LINESHDR)
         LI,R14   7
         BAL,R8   LOADER
         B        VALUE
*
*QCOUNT - GETS COUNT HEADER AND CONV. VALUE IN TEMPBUF
*
QCOUNT   EQU      %
         LI,R13   BA(QCNTHDR)
         LI,R14   7
         BAL,R8   LOADER
         B        VALUE
*
* SPACE - GETS SPACE HEADER AND CONVERTED VALUE INTO TEMPBUF
*
SPACE    EQU      %
         LI,R13   BA(SPCEHDR)
         LI,R14   7
         BAL,R8   LOADER
         B        VALUE
*
* Q8 - WILL GET THE TWO PARALLEL HALFWORDS OF BITS  FROM THE
* Q8 WORDS AND TEST THEM - PUTTING THE PROPER OPTION IN TEMPBUF
*
Q8       EQU      %
         AI,R3    1
         LW,R1    *R1,R3
         LH,R2    R1
         SLS,R1   25                SET UP THE PARALLEL
         SLS,R2   25                BIT TABLES
         SLS,R2   1
         BOD      DRC
         B        PBIN
DRC      SLS,R1   1
         BEV      NODRC
         LI,R13   BA(DRCHDR)
         LI,R14   4
         BAL,R8   LOADER
         B        PBIN+1
NODRC    EQU      %
         LI,R13   BA(NODRCHDR)
         LI,R14   6
         BAL,R8   LOADER
         B        PBIN+1
PBIN     SLS,R1   1
         SLS,R2   1
         BOD      BIN
         B        PPACK
BIN      SLS,R1   1
         BEV      BCD
         LI,R13   BA(BINHDR)
         LI,R14   4
         BAL,R8   LOADER
         B        PPACK+1
BCD      EQU      %
         LI,R13   BA(BCDHDR)
         LI,R14   4
         BAL,R8   LOADER
         B        PPACK+1
PPACK    SLS,R1   1
         SLS,R2   1
         BOD      PACK
         B        PFBCD
PACK     SLS,R1   1
         BEV      UNPACK
         LI,R13   BA(PACKHDR)
         LI,R14   5
         BAL,R8   LOADER
         B        PFBCD+1
UNPACK   EQU      %
         LI,R13   BA(UNPCKHDR)
         LI,R14   7
         BAL,R8   LOADER
         B        PFBCD+1
PFBCD    SLS,R1   1
         SLS,R1   1
         SLS,R2   1
         SLS,R2   1
         BOD      FBCD
         B        PVFC
FBCD     SLS,R1   1
         BEV      NOFBCD
         LI,R13   BA(FBCDHDR)
         LI,R14   5
         BAL,R8   LOADER
         B        PVFC+1
NOFBCD   EQU      %
         LI,R13   BA(NFBCDHDR)
         LI,R14   7
         BAL,R8   LOADER
         B        PVFC+1
PVFC     SLS,R1   1
         SLS,R2   1
         BOD      VFC
         B        PL
VFC      SLS,R1   1
         BEV      NOVFC
         LI,R13   BA(VFCHDR)
         LI,R14   4
         BAL,R8   LOADER
         B        PL+1
NOVFC    EQU      %
         LI,R13   BA(NOVFCHDR)
         LI,R14   6
         BAL,R8   LOADER
         B        PL+1
PL       SLS,R1   1
         SLS,R2   1
         BOD      QL
         B        FINAL
QL       SLS,R1   1
         BEV      NOL
         LI,R13   BA(LHDR)
         LI,R14   2
         BAL,R8   LOADER
         B        FINAL
NOL      EQU      %
         LI,R13   BA(NOLHDR)
         LI,R14   4
         BAL,R8   LOADER
         B        FINAL
         PAGE
*
* FINAL - ASSEMBLES FILEBUF AND TEMPBUF INTO PRTBUF, THEN
* PRINTS THE SET COMMAND, AND TEST FOR LAST DCB AND RETURNS.
*
FINAL    EQU      %
         LI,R4    BA(FILEBUF)
         LI,R5    BA(PRTBUF)
         AW,R5    PRTCTR
         LW,R6    FILBFCTR
         STB,R6   R5
         MBS,R4   0
         LI,R4    BA(TEMPBUF)
         LW,R6    TEMPCTR
         STB,R6   R5
         MBS,R4   0
         BAL,R8   PRINTER
FINAL1   LI,R1    0
         STW,R1   TEMPCTR
         STW,R1   FILBFCTR
         STW,R1   DFLAG
         STW,R1   VFLAG
         LW,R7    NXTPTR
         CI,R7    0
         BE       ENDER
         B        NXTDCB
*
* ENDER - WILL TRANSFER CONTROL BACK TO TEL
*
ENDER    EQU      %
ENDER1   LI,R3    0
         LI,R4    0
CHKASGN  LI,R6    ADCBUF
         AW,R6    R4
         LW,R7    *R6
         CW,R7    ='    '
         BNE      NOTASGN
         AI,R4    3
         AI,R3    1
         CI,R3    12
         BGE      THEEND
         B        CHKASGN
NOTASGN  LB,R1    *R6               GET COUNT
PRTNASN  SLS,R6   2
         AI,R6    1
         LI,R7    BA(PRTBUF)
         STB,R1   R7
         MBS,R6   0
         LI,R6    BA(NASNHDR)
         LI,R1    16
         STB,R1   R7
         MBS,R6   0
         BAL,R8   PRINTER
         AI,R3    1
         AI,R4    3
         B        CHKASGN
THEEND   EQU      %
         M:EXIT
         END      SHOW

