         TITLE    'CP-V VOLUME INITIALIZATION  **  VOLINIT E01'
*
* MOST OF THE CODE OF CP-V VOLINIT IS DERIVED FROM THE CODE OF
* THE ON LINE DIAGNOSTIC MONITOR (OLMON), AND THE THREE DIAGNOSTIC PROGRAMS
* FOR ROTATING MEMORY PROCESSOR (RMP6), FOR ROTATING MEMORY CONTROLLER
* (RMC6), AND FOR REMOVABLE DISK CONTROLLER (RDC6).
* THE INTERFACE BETWEEN THE MONITOR PORTION AND THE DIAGNOSTIC PROGRAM
* PORTION HAS BEEN CHANGED SIGNIFICANTLY IN ORDER TO ELIMINATE
* UNNECESSARY CODE AND TO SIMPLIFY THE INTERFACE.
*
*        5/17/76                    GUENTER  ULSCHMID
*
**************************************************************
**************************************************************
*
         SYSTEM   DIAG
         SYSTEM   BPM
         SYSTEM   SIG9
         REF      M:LO              DCB FOR LOGGING OUTPUT
         REF      M:UC              DCB FOR USER'S CONSOLE
         REF      M:SI              DCB FOR THE INPUT DEVICE
         REF      J:JIT             JOB INFORMATION TABLE
         REF      JB:PRIV
         REF      DCT16,DCT1
         REF      AVRTBLSIZ,AVRTBLNE
         REF      DCTSIZ
         REF      AVRTBL,BATAPE
         REF      HGP,DCT22,DISCLIMS
*
SIM      SET      0                 =0 : NORMAL;  =1 : I/O SIMULATION ON
*
         PAGE
***************************************************************
***************************************************************
***                                                         ***
***                                                         ***
*** PROCEDURES AND ASSIGNMENTS                              ***
***                                                         ***
***                                                         ***
***                                                         ***
***************************************************************
***************************************************************
*
*
*
*        MVW PROCEDURE
*
MVW      CNAME
         PROC
LF       LW,7     AF(1)
         STW,7    AF(2)
         PEND
*
*        MVI PROCEDURE
*
MVI      CNAME
         PROC
LF       LI,7     AF(1)
         STW,7    AF(2)
         PEND
*
*
*        LOOP PROCEDURE
*
LOOP     CNAME                      LOOP WITH INDEX INCR.
         PROC                        AND TEST IF LESS
LF       AI,CF(2) 1                 INCREMENT INDEX
         CW,CF(2) AF(1)             TEST IF LESS
         BL       AF(2)             YES: BRANCH
         PEND
*
*
*
*        TEST PROCEDURE
*
TEST     CNAME                      BRANCH TO FUNCTIONAL
         PROC
LF       BAL,7    #SEQX
         DATA     AF(1)
         PEND
*
*
*        IOCD PROCEDURE
*
IOCD     CNAME                      GIVE THE GEN STATEMENT
         PROC                         WHICH IS USED FOR THE
LF       GEN,8,24,8,24 AF(1),AF(2),AF(3),AF(4)
         PEND                           DEFINITION OF IOCD'S
*
*
*        ETAB PROCECURE
*
ETAB     CNAME
         PROC
LF       GEN,8,24 AF(1),AF(2)
         GEN,4,4,24  X'5',CF(2),0
         GEN,8,24 0,AF(4)
         PEND
*
*
*        LOD PROCEDURE
*
LOD      CNAME
         PROC
I        DO       NUM(AF)
         LW,7     *#SEQPA
         STW,7    AF(I)
         MTW,1    #SEQPA
         FIN
         PEND
*
*
*        SEND PROCEDURE
*
*
SEND     CNAME
         PROC
LF       BAL,15   ERROR
         NOP      AF(1)
         PEND
*
*
TAB      COM,8,24,8,24 AF(1),AF(2),AF(3),AF(4)
*
*
*
PUSH     CNAME
         PROC
         LOCAL    I
LF       EQU      %
I        DO       NUM(AF)
         DO       NUM(AF(I))=1
         PSW,AF(I) STACKDW
         ELSE
         LCI      (AF(I,2)-AF(I,1)+1)&X'F'
         PSM,AF(I,1) STACKDW
         FIN
         FIN
         PEND
*
*
PULL     CNAME
         PROC
         LOCAL    I,K
LF       EQU      %
I        DO       NUM(AF)
K        SET      NUM(AF)-I+1
         DO       NUM(AF(K))=1
         PLW,AF(K) STACKDW
         ELSE
         LCI      (AF(K,2)-AF(K,1)+1)&X'F'
         PLM,AF(K,1) STACKDW
         FIN
         FIN
         PEND
*
*
PURGE    CNAME
         PROC
         LOCAL    I,N
N        SET      0
I        DO       NUM(AF)
         DO       NUM(AF(I))=1
N        SET      N+1
         ELSE
N        SET      N+((AF(I,2)-AF(I,1))&X'F')+1
         FIN
         FIN
LF       LI,0     -N
         MSP,0    STACKDW
         PEND
*
TYPE     CNAME
         PROC
LF       LI,6     AF(1)
         BAL,7    TY:M
         PEND
*
*
TEXTCS   CNAME                      ELIMINATES DISPLAY OF
         PROC                       HEX CONTENTS OF EACH
         DISP     %                 LOCATION WHEN USING A
         LIST     0                 TEXTC DIRECTIVE
LF       TEXTC    AF
         LIST     1
         PEND
*
TEXTS    CNAME                      ELIMINATES DISPLAY OF
         PROC                       HEX CONTENTS OF EACH
         DISP     %                 LOCATION WHEN USING A
         LIST     0                 TEXT  DIRECTIVE
LF       TEXT     AF
         LIST     1
         PEND
*
PZD      CNAME
         PROC
         BOUND    8                 BINDS PZE TO A
LF       DATA     AF                DOUBLEWORD BOUNDRY
         PEND
*
         OPEN     NOP               THIS PROCEDURE ALLOWS CF(2) ENT
NOP      CNAME                        ON A NOP INSTRUCTION WHEN
         PROC                         ASSEMBLED UNDER AP.
LF       GEN,8,4,3,17   X'02',CF(2),AF(2),AF(1)
         PEND
*
*
*
********************************************************************
*        SYSTEM EQUATES                                            *
********************************************************************
*
EM       EQU      C' '              X'00'
CR       EQU      C'
'              X'15'
RETURN   EQU      X'0D'             RETURN ENDS STATEMENT IN
SPACE    EQU      X'40'             SPACE FOR ALLIGNMENT
POINT    EQU      X'4B'             . BYTE POSITION FOLLOWS
ERASE    EQU      X'4C'             < FIELD ERASE
SMSGMOD  EQU      X'4D'             ( SET MESSAGE MODE
PLUS     EQU      X'4E'             + ADD
MULTIPLY EQU      X'5C'             * MULTIPLY
RMSGMOD  EQU      X'5D'             ) RESET MESSAGE MODE
EOR      EQU      X'5E'             ; FIELD EXCLUSIVE OR
MINUS    EQU      X'60'             - SUBTRACT
DIVIDE   EQU      X'61'             / DIVIDE
DLIMETR  EQU      X'6B'             , FIELD DELIMETER
PROMPT   EQU      X'6E'             > PROMPT SEPARATOR
DECIMAL  EQU      X'7A'             : DECIMAL DIGITS TO FOLLOW
EQUAL    EQU      X'7E'             = TYPE ARITHMETIC RESULTS
NEWPAGE  EQU      X'80'
*
*        CONTROL EQUATES
*
STRTBUF  EQU      4                 SIZE OF BUFFER PROMPT
STACKSZ  EQU      96
*
*
*
*  SYMBOLIC REGISTER DEFINITIONS
*
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
*
*        MONITOR I/O EQUATES
*
LOGDEV   EQU      M:LO
TTYDEV   EQU      M:UC
*
*
*
********************************************************************
*        FUNCTIONAL PARAMETER TABLES
********************************************************************
*
*
         CSECT    0
*
*
FPT:P:A  GEN,8,24 X'2C','>'
FPT:P:N  GEN,8,24 X'2C',0
*
*
FPT:LO   GEN,8,24 X'11',M:LO
         DATA     X'34000010'
         PZE      *R6
         PZE      *R7
         DATA      1
*
*
FPT:TY   GEN,8,24 X'11',M:UC
         DATA     X'34000010'
         PZE      *R6
         PZE      *R7
         DATA      1
*
FPT:SI   GEN,8,7,17      X'10',0,M:SI
         DATA     X'34000010'
         PZE      IBUF
         DATA     140               SIZE
         DATA     0                 NO BYTE DISPLACEMENT
*
*
FPT:L1   GEN,8,7,17      X'11',0,M:LO
         DATA     X'34000010'
         PZE      #IBUF             THIS BUFFER ENCLUDES THE INPUT
         PZE      *R7               WITH LEADING 8 BLANKS
         DATA     0                 NO BYTE OFF SET
*
FPT:C2   GEN,8,24 X'2B',M:UC
         DATA     M:SI
*
FPT:L2   GEN,8,24 X'11',M:UC
         DATA     X'34000010'
         PZE      IBUF
         PZE      *R7
         DATA     0
*
FPT:L3   GEN,8,24 X'11',M:UC
         DATA     X'34000010'
         DATA     FPT:P:A
         DATA     1
         DATA     3
*
         PAGE
********************************************************************
*                      I N I T I A L I Z A T I O N   R O U T I N E *
********************************************************************
*
*
         CSECT    0
*
         DEF      VOLINIT
VOLINIT  RES
*
INITIAL  RES
         TYPE     HERE
         LB,R4    JB:PRIV           GET CURRENT USER PRIVELEDGE
         CI,R4    X'A0'             WAS IT AT LEAST A0
         BGE      %+4               IF SO, BRANCH
         TYPE     NOPRIV            ABORT IF LESS THAN A0
         M:EXIT
         LW,R7    #LP
         LW,R8    #CR               ANTICIPATE BATCH DEVICE
         LB,R9    J:JIT             GET JOB TYPE INDICATOR
         SLS,9    -6                RIGHT JUSTIFY PERTINENT BITS
         CI,R9    0                 IS JOB BATCH
         BE       INIT1             YES, SET LABELS TO CR
         LW,R7    #OC               GET OC DCB
         LW,R8    #OC               ANTICIPATE GHOST DEVICE
         CI,R9    1                 IS IT A GHOST JOB
         BE       INIT1             YES, SET LABELS TO OC
         LW,R7    #UC               GET UC DCB
         LW,R8    #UC               ANTICIPATE ON-LINE DEVICE
INIT1    STW,R7   LO                 OPERATOR TABLE
         STW,R8   SI
         LW,R14   LO
         STW,R14  OLDLO
         M:PC     0
         M:INT    BREAK             ACTIVATE OWN BRK CONTROL
         LW,R8    X'2B'             GET SYSTEM PARAMETERS
         AND,R8   XC0               MASK FOR MACH TYPE CODE
         LI,R9    X'560'            R9 = MACH. TYPE IN HEX
         CI,R8    X'C0'
         BE       INIT2             BRANCH IF XEROX 560
         LI,R9    9
         CI,R8    X'80'
         BE       INIT2             BRANCH IF SIGMA 9
         LI,R9    7
INIT2    RES
         STW,9    #MTYPE            SAVE MACHINE TYPE
*
* MAP THE CONTINUANT REAL PAGES WHERE THE IOTABLES ARE LOCATED
* INTO CONTINUANT VIRTUAL MEMORY THAT WE CAN ACCESS WITH 'A0' PRIVILEDGE.
*
         M:GDDL                     GET START OF FREE VIRTUAL MEMORY
         LW,R13   R8                  AND SAVE THE ADDRESS
         AI,R13   -512                  AND ADJUST IT
         LI,R4    0                 RESET INDEX
         LW,R14   CVMLIST           INIT. REAL MEMORY PAGE ADDR.
         AND,R14  =X'FFFFFE00'
INIT3    RES
         AI,R13   512                 AND THE CORRESPONDING VIRTUAL MEM. PAGE
         M:CVM    *R14,*R13         RESERVE NEXT PAGE OF VIRTUAL MEMORY
         BCR,8    INIT32            OK: GO ON
         TYPE     MSG:MP            CANNOT ACCESS MONITOR LOCATIONS
         M:EXIT
INIT32   RES
         AI,R14   512               INCR. REAL MEMORY PAGE
INIT34   RES
         LW,R12   CVMLIST,R4        GET REAL MEMORY LOCATION
         CW,R12   R14               CHECK IF ALREADY MAPPED INTO
         BGE      INIT3              VIRTUAL MEMORRY; NO: MAP IT
         AND,R12  =X'01FF'          ELSE: CALCULATE THE CORRECT
         AW,R12   R13                        VIRTUAL ADDR. FOR THIS ITEM
         STW,R12  CVMLIST,R4        AND STORE IT
*
         AI,R4    1
         CI,R4    CVMSZ
         BL       INIT34
         B        INIT4
*
*
***********************************************************************
*        COMMAND TABLE
***********************************************************************
*
*        AF(1)= BYTE COUNT OF COMMAND
*        AF(2)= FIRST 3 LETTERS OF COMMAND
*        AF(3)= COMMAND MAP: BIT6= YYNDD REQUIRED
*                            BIT7= SN,ACCT,NGC REQUIRED
*        AF(4)= COMMAND ROUTINE ADDRESS
*
         BOUND    8
CTAB     EQU      %-2
         TAB      4,'CVO',3,CVOL
         TAB      4,'FVO',3,FVOL
         TAB      5,'WVT',3,WVTOC
         TAB      4,'DIA',3,DIAG
         TAB      5,'RVT',2,RVTOC
         TAB      4,'LIS',2,LIST
         TAB      4,'FLA',6,FLAW
         TAB      4,'HEL',0,HELP
         TAB      3,'END',0,END
CTABSZ   EQU      (%-CTAB-2)/2
*
MSG:CR   TEXTCS   CR
MSG:YYNDD TEXTCS  'YYNDD>'
MSG:SN   TEXTCS   '   SN>'
MSG:ACCT TEXTCS   ' ACCT>'
MSG:NGC  TEXTCS   '  NGC>'
MSG:SEEK TEXTCS   'SEEK >'
MSG:EH   TEXTCS   'EH?',CR
*
*
***********************************************************************
*        COMMAND EXECUTION LEVEL
***********************************************************************
*
INIT4    RES
         LI,R0    0
         LI,R1    1
         LI,R2    2
         LI,R3    3
         CAL1,1   FPT:P:A           SET PROMT CHARACTER >
         LD,R8    NEWSTACK          PURGE STACK
         STD,R8   STACKDW
         LI,R0    0                 REST
         STW,R0   DIAGFLG           RESET DIAG FLAG
         MVW      =10,RETRY
         LI,R6    MSG:CR            PRINT CARRIAGE RETURN
         BAL,R7   TY:M
         BAL,R7   RD:SI             READ COMMAND
         LW,R10   IBUF                AND GET WORD FROM INPUT BUFFER
         SLS,R10  -8                   PREPARE FOR COMPARISON
         STB,R6   R10
*
         LI,R4    CTABSZ            GET TABLE SIZE AS INDEX
         LD,R8    CTAB,R4           GET ENTRY OF TABLE
         CW,R8    R10                AND CHECK
         BE       INIT5             GO: PROCESS COMMAND
         BDR,R4   %-3               LOOP
         LI,R6    MSG:EH            GIVE EH? MESSAGE
         BAL,R7   TY:M
         B        INIT4
*
INIT5    RES
         STW,R9   CMDADR            SAVE COMMAND ADDRESS
         AND,R9   =X'02000000'      TEST FOR YYNDD REQUIREMENT
         BEZ      INIT6             NO
INIT52   RES
         LI,R6    MSG:YYNDD
         BAL,R7   TY:M              PRINT: YYNDD>
         BAL,R7   RD:SI             READ YYNDD RESPONSE
*
         LW,R7    IBUF              GET INPUT DATA
         SLS,R7   -16
         AND,R7   =X'0000FFFF'
         STW,R7   DEVTYP
         CI,R6    5                  AND CHECK IF IT IS 5 CHARACTERS
         BE       INIT57
         CI,R6    2                 CHECK IF THERE ARE TWO CHAR.
         BE       INIT54
         CI,R6    0                 CHECK FOR NULL RETURN
         BE       INIT4             RETURN TO COMMAND LEVEL
*
         LI,R6    MSG:EH
INIT53   RES
         BAL,R7   TY:M
         B        INIT52
*
***********************************************************************
*        FIND A PRIVATE, AVAILABLE DISK PACK
***********************************************************************
*
INIT54   RES
         LI,R4    DCTSIZ
INIT55   RES
         BDR,4    INIT56
         LI,R6    MSG:E7            PRINT: NO SUCH DEVICE AVAILABLE
         B        INIT53
*
INIT56   RES
         LD,R8    *%DCT16,R4        GET ENTRY OF DCT16 TABLE
         SLD,R8   8                    AND
         AND,R8   =X'0000FFFF'           PREPARE TO ISOLATE
         CW,R8    DEVTYP                   THE DEVICE MNEMONIC
         BNE      INIT55            NO: LOOP
*
         CI,R4    BATAPE+AVRTBLSIZ
         BL       INIT55
         CI,R4    BATAPE+AVRTBLNE
         BGE      INIT55
         LW,R5    R4
         AI,R5    -BATAPE
         LD,R12   *%AVRTBL,R5
         LC       R13
         BCS,10   INIT55
         MTW,0    R12               CHECK IF A PACK MOUNTED
         BNEZ     INIT55
         B        INIT59
*
INIT57   RES
         LW,R2    IBUF
         LW,R3    IBUF+1
         SLD,R2   8
         LW,R3    =X'00FFFFFF'
         LI,R4    DCTSIZ+DCTSIZ
         CS,2     *%DCT16,R4        FIND DCT INDEX
         BE       %+3
         BDR,R4   %-2
         B        INIT582
         SLS,R4   -1
         CI,R4    BATAPE+AVRTBLSIZ     AND VERIFY THAT WE HAVE
         BL       INIT583
         CI,R4    BATAPE+AVRTBLNE           A DISC OR A PACK
         BGE      INIT583
         LW,R5    R4
         AI,R5    -BATAPE
         LD,R12   *%AVRTBL,R5
         LC       R13
         BCS,8    INIT584           REPORT : PUBLIC PACK
         MTW,0    R12               CHECK IF A PACK MOUNTED
         BNEZ     INIT585           YES: ABORT
         LI,R2    2
         LI,R3    3
         B        INIT59
*
INIT582  LI,R6    MSG:E2
         B        INIT53            PRINT ERROR MESSAGE
INIT583  LI,R6    MSG:E3
         B        INIT53            PRINT ERROR MESSAGE
INIT584  LI,R6    MSG:E4
         B        INIT53            PRINT ERROR MESSAGE
INIT585  LI,R6    MSG:E5
         B        INIT53            PRINT ERROR MESSAGE
INIT586  LI,R6    MSG:E6
         B        INIT53            PRINT ERROR MESSAGE
*
*
INIT59   RES
         STW,R4   DCT:X             SAVE DCT INDEX
         LH,R7    *%DCT1,R4           AND THE DEVICE ADDRESS
         STW,R7   UA
         LD,R8    *%DCT16,R4        GET IT AGAIN FOR MSG
         STD,R8   DEV:YYNDD         SAVE DCT ENTRY
         STB,R9   KEYIN+7           STORE LAST CHARACTER
         SLD,R8   24
         STW,R8   KEYIN+6           STORE IN OPERATOR MESSAGE
         M:DMOD#  *UA               GET MODEL # FROM CPV
         BCS,8    INIT582
         STW,8    DMOD              SAVE DEVICE MODEL NUMBER
         STW,9    CMOD                AND CONTROLER MODEL NUMBER
         STW,R10  F%TYP               AND FLAGS + TYPE ID
         MTW,0    R10
         BL       INIT585
         AND,R10  =X'FFFF'
         CW,R10   DEVTYP
         BNE      INIT583
         LI,R8    ERRFILE           GET ERR FILE ADDRESS
         STW,R8   EFSTK             INITIALIZE ERR FILE ADDRESS
         STW,R8   ERRBUF            SET INITIAL ERR FILE ADDRESS
         LW,R7    CMOD
         BAL,R15  #CONFIG           INITIALIZE THE FDP
         B        INIT6
         B        INIT4
*
***********************************************************************
*        REQUEST SERIAL NUMBER, ACCOUNT NUMBER, AND NGC NUMBER
***********************************************************************
*
INIT6    RES
         LW,R7    CMDADR            GET COMMAND ADDRESS + MAP
         AND,R7   =X'01000000'
         BEZ      INIT7
*
         LI,R6    MSG:SN            PRINT SN MESSAGE
         BAL,R7   TY:M
         BAL,R7   RD:SI             GET SERIAL NUMBER INPUT
         MTW,0    R6                CHECK FOR ZERO CHARACTERS
         BLE      INIT62            YES: GO TO NEXT REQUEST
         LI,R4    7
         LI,R5    ' '               FILL THE INPUT BUFFER WITH
         STB,R5   IBUF,R6              BLANKS
         AI,R6    1
         BDR,R4   %-2
         LW,R4    IBUF
         STW,R4   KEYIN+4           STORE SERIAL NUMBER IN MSG
         STW,4    VTOC+1
*
INIT62   RES
*
         LI,R3    0                 ZERO NUMBER OF ACCOUNTS
         STW,R3   #ACCOUNTS           FOR TALLY.
**
**   ACCEPT AND SAVE ACCOUNT LIST WHICH IS LIMITED TO 96
**   ENTRIES.
**
INIT621  EQU      %
         LI,R6    MSG:ACCT          ASK FOR
         BAL,R7   TY:M                NEXT ACCOUNT.
*
         BAL,R7   RD:SI             ACCEPT REPLY.
*
         CI,R6    0                 IF ZERO LENGTH REPLY,
         BLE      INIT623             END OF ACCOUNT LIST.
*
         LI,R7    ' '               BLANK
         STB,R7   IBUF,R6             OUT
         AI,R6    1                   REST
         CI,R6    7                   OF
         BLE      %-3                 BUFFER.
*
         LD,R6    IBUF              GET ACCOUNT NUMBER.
         LW,R5    #ACCOUNTS         JUST PUT IN TABLE
         BEZ      INIT6225            IF NO ENTRIES YET.
INIT6222 CD,R6    ACNTBL-2,R5       IF ALREADY
         BNE      INIT6223            IN TABLE,
         LI,R6    MSG:E8              TELL USER
         LI,R7    INIT621             AND IGNORE IT.
         B        TY:M
INIT6223 BDR,R5   INIT6222
*
         LW,R5    #ACCOUNTS         PUT NEW ENTRY
INIT6225 STD,R6   ACNTBL,R5           IN TABLE.
         MTW,1    #ACCOUNTS         INCREASE # ACCOUNTS.
*
         CI,R5    95                GET 'NUTHER IF
         BL       INIT621             ROOM LEFT.
**
**   NO ACCOUNTS INPUT MEANS SET UP AN AD WITH ONE NULL ENTRY.
**
INIT623  EQU      %
         LW,R7    #ACCOUNTS         IF NONE WERE INPUT,
         BGZ      %+4                 FAKE
         LI,R5    0                   ONE
         STD,R5   ACNTBL              NULL
         MTW,1    #ACCOUNTS           ENTRY.
**
**   GET NGC.
**
INIT64   RES
         LI,R6    MSG:NGC           PRINT NGC MESSAGE
         BAL,R7   TY:M
         BAL,R7   RD:SI            GET NUMBER OF GRANULES PER CYL
         CI,R6    0                 CHECK NUMBER OF CHARACTERS
         BLEZ     INIT68            CONTINUE
         CI,R6    2                 CHECK FOR MORE THAN 2
         BLE      INIT66            OK
         LI,R6    MSG:EH
         BAL,R7   TY:M              PRINT:  EH?
         B        INIT64
*
INIT66   RES
         LW,R13   IBUF              GET NGC CHARACTERS
         SLS,R13  -16                 SHIFT IN POSITION
         B        %,R6              IF ONLY SINGLE DIGIT,
         SLS,R13  -8                  SHIFT OFF CR.
         BAL,R15  EBCTOHEX             AND CONVERT IN HEX
         STW,R13  NGC                   AND SAVE THE NGC VALUE
INIT68   RES
         LW,R1    DCT:X             GET DCT INDEX
         LW,R7    DCT:X              AND ANOTHER TIME
         AI,R7    -BATAPE             AND ADJUST THIS FOR AVRTABLE
         LD,R2    *%AVRTBL,R7       GET ENTRY FROM AVRTABL
         INT,7    3
         AW,7     %HGP
         LI,2     7                 GET DEFAULT CYL SIZ
         LB,3     *7,2              GET NUMBER OF GRANULES/CYLINDER (NGC)
         CI,R6    0
         BG       %+2               CHECK FOR DEFAULT VALUE
         STW,R3   NGC               SAVE NGC VALUE
         LB,4     *%DCT22,1         FIGURE # CYLS
         LW,5     *%DISCLIMS,4      GET NUMBER OF SECTORS
         SLS,5    -1                 AND DIVIDE BY 2 TO GET GRANULES
         DW,5     NGC               DIVIDE BY NGC
         AI,5     31                 AND ADD 31
         SLD,4    27                #WORDS BIT MAP
         STB,5    4                 ZAP GARBAGE
         CW,4     4,7               WILL IT FIT
         BLE      %+3
         TYPE     MSG:BM            BAD VTOC
         STW,4    VTOC+4            PER MAPWL VALUE
*
         LI,R3    -1                INITIALIZE THE BIT MAP TO
         STW,R3   VTOC+7-1,R4         'ALL CYLINDERS UNALLOCATED'.
         BDR,R4   %-1
*
         LW,R4    VTOC+4            RESTORE MAPWL VALUE.
         LW,R3    NGC               GET NGC VALUE
         STH,3    VTOC+4            NO. OF GRANULES/CYLINDER (NGC)
         AI,4     7
         STW,4    VTOC+3
         SLS,5    -27               FIGURE WHAT LAST WORD IS
         LCW,5    5
         LI,4     -1
         SLS,4    31,5
         LW,5     VTOC+3
         CI,5     511
         BGE      INIT586
         STW,4    VTOC-1,5          STORE IN LAST WORD
         LI,0     0
         STW,0    VTOC,5
         LI,4     -3                NOW SET FIRST WORD AND NGAVAL
         LI,5     -1
         SLS,5    -1
         AH,4     VTOC+4
         CI,4     27
         BL       %-3               MUST HAVE AT LEAST 30 GRANS
         STW,5    VTOC+7
**
**   SORT ACCOUNT TABLE.
**
         LW,R7    #ACCOUNTS         GET # ACCOUNTS ENTERED.
         AI,R7    -1                IF ONLY ONE ACCOUNT,
         BLEZ     INIT696             NO NEED TO SORT.
**
**   SHRINKING LIST BUBBLE SORT.
**
         LI,R15   8                 ACCOUNT NUMBER LENGTH.
         STW,R7   #UNSORTED         INIT SORT W/IX OF LAST ENTRY.
*
INIT694  EQU      %
         LI,R1    0                 INITIALIZE SORT PASS BY
         STW,R1   LAST%SWAP%IX        ASSUMING NO EXCHANGES ARE MADE.
*
         LD,R2    1STACNTBLPTR      INITIALIZE CBS
         STD,R2   ACNTBLPTR           DOUBLEWORD POINTER.
         B        INIT6955          BEGIN SORT.
**
**   DRAG GREATEST ENTRY IN TABLE DOWN TO THE BOTTOM.
**
INIT695  EQU      %
         AWM,R15  ACNTBLPTR         INCREMENT CBS POINTER
         AWM,R15  ACNTBLPTR+1         TO POINT TO THE NEXT
         LD,R2    ACNTBLPTR           PAIR OF ADJACENT ENTRIES.
*
INIT6955 EQU      %
         CBS,R2   0                 COMPARE NEXT TWO ENTRIES HOPING
         BLE      INIT6957            THAT FIRST PRECEDES SECOND.
*
         LD,R4    ACNTBL,R1         EXCHANGE
         LD,R6    ACNTBL+2,R1
         STD,R4   ACNTBL+2,R1         ENTRIES.
         STD,R6   ACNTBL,R1
         STW,R1   LAST%SWAP%IX      SAVE IX OF LAST UNSORTED ENTRY.
*
INIT6957 EQU      %
         AI,R1    1                 COMPARE NEXT TWO
         CW,R1    #UNSORTED           ADJACENT ENTRIES IF
         BL       INIT695             PASS IS NOT DONE.
*
         LW,R1    LAST%SWAP%IX      ONLY NEED TO SORT TO
         STW,R1   #UNSORTED           POINT OF LAST SWAP
         BGZ      INIT694             IF TABLE IS STILL UNSORTED.
**
**   THE TABLE IS NOW SORTED.  THE ACCOUNT DIRECTORY (AD) MUST
**   BE SET UP.
**
INIT696  EQU      %
         LW,R15   NGC               FROM NUMBER OF GRAN/CYL
         SLS,R15  1                   CALC NUMBER OF
         STW,R15  NSC                 SECTORS/CYL.
*
         LI,R1    -4                MAKE SURE SECTOR 4 CAN
         AW,R1    NSC                 BE USED AS
         BLEZ     %-1                 THE LAST FD FDA.
         AI,R1    X'10004'          SET ADDRESS OF
         STW,R1   ADENTSKEL+DABLK     FIRST FD.
*
         LD,R2    ADACNPTR          GET MBS DOUBLEWORD POINTER WHICH
*                                     MOVES ENTRY SKELETON TO AD.
         LI,R1    0                 INIT INDEX OF FIRST (LEAST) ENTRY.
         LW,R5    #ACCOUNTS         INIT NUMBER OF ENTRIES TO SET UP.
         AI,R5   -1                 IF FIRST IS ALSO LAST,
         BLEZ     INIT697             SPECIAL HANDLING REQUIRED.
*
INIT6965 EQU      %
         LD,R6    ACNTBL,R1         MOVE NEXT ENTRY
         STD,R6   ADENTSKEL+ACN       FROM LIST TO SKELETON.
         MBS,R2   0                 MOVE NEXT ENTRY TO AD.
*
         AD,R2    ADACNRST          RE-INIT ENTRY SKELETON PTR.
         AWM,R15  ADENTSKEL+DABLK   FD FDA STARTS ON NEXT LOGICAL CYL.
         AI,R1    1                 INCREMENT ACCOUNT TABLE INDEX AND
         BDR,R5   INIT6965            CONTINUE IF MORE THAN ONE LEFT.
**
**  SPECIAL HANDLING OF LAST AD ENTRY:  FD STARTS AT FIRST SECTOR
**  FOLLOWING VTOC AND AD; EOF BIT MUST BE SET.
**
INIT697  EQU      %
         LD,R6    ACNTBL,R1         MOVE LAST ACCOUNT NUMBER
         STD,R6   ADENTSKEL+ACN       TO ENTRY SKELETON.
         LI,R15   X'200'            EOF BIT
         AWM,R15  ADENTSKEL+EOF       IS SET.
         LI,R15   X'10004'          FDA OF GRANULE FOLLOWING
         STW,R15  ADENTSKEL+DABLK     AD IS FD FDA.
         MBS,R2   0                 MOVE LAST ENTRY TO AD.
*
         AI,R3    -BA(ACND)         INDEX OF NEXT FREE AD BYTE
         STH,R3   ACND+NAV            MUST BE USED AS NAV.
*
         LI,R2    0                 WHILE WE'RE AT IT,
         STB,R2   ACND,R3             CLEAN UP
         AI,R3    1                   THE REST
         CI,R3    512*4               OF THE
         BL       %-3                 AD.
**
**   SET UP VTOC BIT MAP TO INDICATE CYLINDERS ALLOCATED TO VTOC,
**   AD, AND THE FILE DIRECTORIES.  IF THE NUMBER OF GRANULES/CYL
**   IS 3 OR GREATER, THE NUMBER OF ALLOCATED CYLINDERS IS JUST
**   THE NUMBER OF ACCOUNTS SINCE THE LAST FILE DIRECTORY IS
**   ALLOCATED FROM THE FIRST CYLINDER WHICH ALSO CONTAINS THE
**   VTOC AND AD.  IF NGC IS 2, THE VTOC AND AD OCCUPY THE FIRST
**   CYLINDER ALONE.  IF NGC IS 1, THE VTOC AND AD EACH HAVE THEIR
**   OWN CYLINDER.
**
         LI,R2    0                 ASSUME NGC IS GREATER THAN 3.
         LCW,R3   NGC               IF IT ISN'T,
         AI,R3    3                   WE'LL ALLOCATE
         BLEZ     %+2                 DEPENDING ON
         AW,R2    R3                  ITS VALUE.
*
         AW,R2    #ACCOUNTS         (R2) = # CYLS TO ALLOCATE.
         LW,R3    R2                INCREASE # CYLS TO CONTAIN
         MW,R3    NGC                 AT LEAST 30 GRANS. (R3) =
         CI,R2    30                  # GRANS IN (R2) CYLS.
         BGE      %+4
         AI,R2    1                 ONE MORE CYL =
         AW,R3    NGC                 NGC MORE GRANS.
         B        %-4
         LI,R3    0                 CALCULATE THE NUMBER
         SLD,R2   -5                  OF WORDS TO ZERO
         SCS,R3   5                   AND THE NUMBER OF ZEROED BITS.
*
         LI,R4    -1                FORM MAP WORD OF
         LCW,R3   R3                  ZEROED BITS.
         SLS,R4   0,R3
         STW,R4   VTOC+7,R2         MOVE IT TO THE BIT MAP.
*
         AI,R2    0                 IF
         BLEZ     %+4                 NECESSARY,
         LI,R4    0                   ZERO
         STW,R4   VTOC+7-1,R2         FULL MAP
         BDR,R2   %-1                 BIT WORDS.
*
         LI,R1    1                 RESTORE R1.
         LI,R2    2
         LI,R3    3
         B        INIT8
*
***********************************************************************
*        REQUEST SEEK ADDRESSES
***********************************************************************
*
INIT7    RES
         LW,R7    CMDADR            CHECK FOR SEEK ADDRESS REQUEST
         AND,R7   =X'04000000'
         BEZ      INIT8             NO
         LI,R4    -256
         STW,R0   BF3+256,R4
         BIR,R4   %-1
         LI,R4    -256
INIT71   RES
         LI,R6    MSG:SEEK          PRINT MSG
         BAL,R7   TY:M
         BAL,R7   RD:SI
         MTW,0    R6                CHECK FOR CR ONLY
         BLE      INIT76            YES: CONTINUE
         CI,R6    8                 CHECK FOR CORRECT AMMOUNT OF
         BE       INIT74              CHARACTERS
INIT72   RES
         LI,R6    MSG:EH            ELSE:  PRINT EH
         BAL,R7   TY:M
         B        INIT71
INIT74   RES
         LW,R13   IBUF+1
         BAL,R15  EBCTOHEX          CONVERT TO HEX
         STW,R13  R10
         LW,R13   IBUF
         BAL,R15  EBCTOHEX
         STH,R13  R10
         BAL,R15  ADRCHK            CHECK INPUT FOR VALID SEEK ADR.
         B        INIT72            ERROR RETURN
         STW,R10  BF3+256,R4
         AI,R4    1
         BIR,R4   INIT71
INIT76   RES
         AI,R4    256
         BEZ      INIT4
         AI,4     BF3
         STW,R4   UT15P
         B        INIT8
*
*
***********************************************************************
*        REQUEST THE DIAG KEYIN FROM THE OPERATOR
***********************************************************************
*
INIT8    RES
         LW,R7    CMDADR            GET MAP
         AND,R7   =X'02000000'
         BEZ      INIT9
         LW,R14   J:JIT             GET USER ID AND CONVERT
         AND,R14  =X'FFFF'
         BAL,R15  HEXTOEBC            IT IN EBCDIC CHARACTERS
         LI,R1    1
         STW,R13  KEYIN+12              AND STORE IT IN MSG
*
         LI,R12   37                SET RETRY LOOP COUNT
INIT82   RES
         M:DMOD#  *UA               GET DIAG KEYIN INDICATOR
         BCS,8    UAERR             REPORT IF INCORRECT
         AND,R10  BIT3              MASK FOR KEYIN BIT
         CW,R10   BIT3              HAS KEYIN BEEN MADE
         BE       INIT84            IF SO, BRANCH
         MTW,-1   R12               DECREMENT RETRY COUNT
         BNEZ     %+4               BRANCH IF NOT 6TH RETRY
         TYPE     TERM              SEND TERMINATION MSG
         B        ABORT              AND ABORT
         LI,R2    0
         LW,R3    R12               R1+R2=64 BIT DIVIDEND
         DW,R2    X6                ...DEVIDE R6 BY 6
         MTW,0    R2                CHECK FOR REMAINDER
         BEZ      %+3               MAKE CHECK EVERY 10 SECS...
         M:WAIT   6                  FOR 5 LOOPS, THEN MAKE
         B        INIT82             CHECK AFTER 30 SEC, THEN REPEAT.
         TYPE     PAUSE             SIMUALTE PAUSE MESSAGE
         DO       SIM
         TYPE     KEYIN
         B        INIT84
         ELSE
         M:MESSAGE (MESS,KEYIN)
         FIN
         M:WAIT   6
         B        INIT82            TRY AGAIN.
*
INIT84   RES
         M:DMOD#  *UA               GET PARTITION STATUS
         BCS,8    UAERR             REPORT IF INCORRECT
         LI,R0    1                 INITIAL DEVICE STATE FLAG: PARTITIONED
         LW,R5    R10               GET VALUE AND
         AND,R5   BIT1                CHECK IF DEVICE PARTITIONED
         BCS,2    INIT88            YES: GO ON
*
         DO       SIM=0
         M:DPART  (DEV,*UA)         PARTITION DEVICE
         BCR,12   INIT86            OK: DEVICE IS PARTIONED
*
         TYPE     MSG:PE            PARTITIONING ERROR
         B        INIT4
         FIN
*
INIT86   RES
         DO       SIM=0
         LD,R8    DEV:YYNDD         GET DCT ENTRY
         STW,R9   MSG:DP+1
         LI,R1    1
         STH,R8   MSG:DP,1
         M:MESSAGE (MESS,MSG:DP)
         FIN
*
INIT88   RES
         LW,R12   OLDUA             GET THE OLD UNIT ADDRESS
         BEZ      INIT89            FIRST RUN
         CW,R12   UA                NO: CHECK IF EQUAL WITH NEW UA
         BE       INIT895           YES
         XW,R12   UA                SUBSTITUTE UA
         BAL,R15  DCLOSE               TO CLOSE AND RELEASE THE DCB/DEVICE
         STW,R12  UA                RESTORE UA
INIT89   RES
         LW,R12   UA
         STW,R12  OLDUA             LOAD OLDUA
         LW,R12   F%TYP
         STW,R12  OLDF%TYP          LOAD OLD F%TYP
INIT895  EQU      %
         BAL,R15  DOPEN             OPEN THE DIAG. DCB
         LD,R8    DEV:YYNDD         SAVE LAST DEVICE OPENED.
         STD,R8   PDEV:YYNDD
*
INIT9    RES
         STW,R1   FDPITO
         STW,R1   TMITO
         LI,R0    0                 CLEAR BUFFERS
         LI,R1    PATCH-IBUF
         STW,R0   IBUF-1,R1
         BDR,R1   %-1
         STW,R0   EXFLG             RESET EXECUTION FLAG
         LI,R1    1
         STW,R1   #PC               SET PRINT CONTROL TO 1
         B        *CMDADR           BRANCH TO COMMAND ROUTINE
*
*
*
***********************************************************************
*        COMMAND ROUTINES
***********************************************************************
*
*
CVOL     RES
         LI,R8    15                EXECUTE ROUTINE 15
         BAL,R7   EXROUT
         LI,R8    16
         BAL,R7   EXROUT              AND  ROUTINE 16
         B        INIT4
*
FVOL     RES
         LI,R8    12
         BAL,R7   EXROUT
         LI,R8    16
         BAL,R7   EXROUT
         B        INIT4
*
WVTOC    RES
         LI,R8    16
         BAL,R7   EXROUT
         B        INIT4
*
DIAG     RES
         LI,R8    15                ROUTINE NUMBER FOR VOLUME INIT.
         STW,R8   TMFIRST            STORE IN FIRST ROUTINE NUMBER
         LI,R8    16                ROUTINE FOR VTOC WRITE OPERATION
         STW,R8   TMLAST             STORE IN LAST ROUTINE NUMBER
         CAL1,1   FPT:P:N           RESET PROMTING
         MTW,1    DIAGFLG           SET THE DIAG FLAG
         LI,R7    7
         STW,R7   #PC               SET PRINT CONTROL TO 7
         LI,R2    BA(RUNMSG)
         LI,R3    X'14'             FORCE H> PROMPT
         BAL,R15  CCPTTY
         BAL,R15  FDPBGN
         B        DIAG
*
RVTOC    RES
         LI,R8    17
         BAL,R7   EXROUT
         LW,R14   BF1+1             GET SERIAL NUMBER
         STW,R14  P:SN+2
         LI,R6    P:SN
         BAL,R7   TY:M
**
**   LIST ACCOUNT NUMBERS AND THEIR FILE DIRECTORY SECTOR NUMBERS.
**
         LH,R8    BF1+512+2         USE NAV FROM AD TO CALC BA OF
         AI,R8    BA(BF1)+512*4       FIRST UNUSED BYTE.
         LI,R14   BA(BF1)+(512+4)*4 INIT ACCOUNT NUMBER SOURCE PTR.
*
RVTOC10  EQU      %
         LW,R15   =X'08000008'+BA(P:ACCT) MOVE ACCOUNT NUMBER
         MBS,R14  0                   TO OUTPUT BUFFER.
*
         AI,R14   2                 MOVE SECTOR
         LW,R15   =X'02000002'+R7*4   NUMBER TO
         MBS,R14  0                   TEMP REG RIGHT HW.
         XW,R7    R14               SAVE SOURCE PTR; LOAD ARG REG.
         BAL,R15  HEXTOEBC          CONVERT SECTOR # TO EBCDIC
         STW,R13  P:ACCT+5            AND MOVE IT TO OUTPUT BUFFER.
         LW,R14   R7                RESTORE SOURCE PTR.
*
         LI,R6    P:ACCT
         BAL,R7   TY:M
*
         AI,R14   21-8-4            POINT MBS SOURCE AT NEXT ACN.
         CW,R14   R8                IF NOT PAST FIRST UNUSED BYTE
         BL       RVTOC10             OF AD, WE'RE NOT DONE YET.
*
         LH,R14   BF1+4
         BAL,R15  HEXTOEBC
         STW,R13  P:NGC+2
         LI,R6    P:NGC
         BAL,R7   TY:M
         B        INIT4
*
LIST     RES
         LI,R8    19
         BAL,R7   EXROUT
         B        INIT4
*
FLAW     RES
         LI,R8    20
         BAL,R7   EXROUT
         B        INIT4
*
HELP     RES
         LI,R4    -HELP:MSZ         GET SIZE OF TEXTC MSGS
         LW,R6    HELP:ML+HELP:MSZ,R4
         BAL,R7   TY:M              PRINT MESSAGE
         BIR,R4   %-2
         B        INIT4
*
HELP:ML  DATA     MSG:H1
         DATA     MSG:H2,MSG:H21
         DATA     MSG:H3,MSG:H31
         DATA     MSG:H4,MSG:H41,MSG:H42,MSG:H43
         DATA     MSG:H5
         DATA     MSG:H6
         DATA     MSG:H7
         DATA     MSG:H8,MSG:H81,MSG:H82,MSG:H83,MSG:H84,MSG:H85
         DATA     MSG:H86,MSG:H87,MSG:H88
*
HELP:MSZ EQU      %-HELP:ML
*
MSG:H1  TEXTCS 'CVOL     Complete volume initialization',CR
MSG:H2  TEXTCS 'FVOL     Fast volume initialization',CR
MSG:H21 TEXTCS '         use FVOL only for disk packs without flaws',CR
MSG:H3  TEXTCS 'WVTOC    Write  Volume table of contents',CR
MSG:H31 TEXTCS '         use WVTOC only to change SN, ACCT, or NGC',CR
MSG:H4  TEXTCS 'RVTOC    Read  volume table of contents',CR
MSG:H41 TEXTCS 'LIST     List all flawed sectors and the alternates',CR
MSG:H42 TEXTCS 'FLAW     Flaw the specified sectors and assign',CR
MSG:H43 TEXTCS '         the next available alternate sector',CR
MSG:H5  TEXTCS 'HELP     Print Commands and their significance',CR
MSG:H6  TEXTCS 'DIAG     Enter the diagnostic directive level',CR
MSG:H7  TEXTCS 'END      Terminate the execution of CP-V VOLINIT',CR
MSG:H8  TEXTCS 'YYNDD>>  Enter device address in the form YYNDD or',CR
MSG:H81 TEXTCS '         enter only the mnemonic YY.',CR
MSG:H82 TEXTCS 'SN   >>  Enter the serial number of the pack',CR
MSG:H83 TEXTCS 'ACCT >>  Enter the account number of the pack',CR
MSG:H84 TEXTCS 'NGC  >>  Enter the number of granules per logical',CR
MSG:H85 TEXTCS '         cylinder, CR only gives the system default',CR
MSG:H86 TEXTCS 'SEEK >   Enter the sector (or one sector addr. for',CR
MSG:H87 TEXTCS '         each track or track pair) which shall be ',CR
MSG:H88  TEXTCS '        flawed in addition. Check with LIST.',CR
*
END      RES
         BAL,R15  DCLOSE            CLOSE DCB AND RELEASE DEVICE
         M:EXIT
*
EXROUT   RES
         PUSH     R7
         STW,R8   TMFIRST
         STW,R8   TMLAST
         MTW,0    EXFLG             CHECK EXECUTION FLAG
         BNEZ     %+3               SKIP RUNNNING MSG
         LI,R6    MSG:RUN
         BAL,R7   TY:M
         MTW,1    EXFLG             INCR. EXECUTION FLAG
         BAL,R15  FDPBGN
         PULL     R7
         B        *R7
*
*
         PAGE
********************************************************************
*                         I N T E R F A C E   R O U T I N E S      *
********************************************************************
*
FDPBGN   RES
         STW,R15  CMDRTN            SAVE RETURN ADDRESS
         CAL1,1   FPT:P:N           CLEAR PROMPTING
FDPBGN1  LI,R15   1
         STW,R15  FDPIT             SET FDP ITERATION COUNTER
         LI,R15   0
         STW,R15  FDPERR            CLR FDP ERR COUNT
FDPBGN1A RES
         LI,R15   0
         STW,R15  TMEXEC            INITIALIZE EXECUTION COUNT
         STW,R15  TMABORT           INITIALIZE WRITE PROTECT CNT.
         STW,R15  CNTRLRAB          RESET CONTRLR TM'S ABORTED CNT
         STW,R15  UABORT            RST BAD ADDR ABORT COUNT
         STW,R15  OFFLTM            RESET OFF-LINE TM'S ABORTED CNT
         LW,R15   TMFIRST
         STW,R15  TMI               SET TM COUNTER
         B        #START            BRANCH TO START IN MODULE B
         B        FDPBGN1
*
*
***************************************************************
* FDPEND - FUNCTIONAL DIAGNOSTIC PROGRAM END ROUTINE
***************************************************************
*
FDPEND   RES
         MTW,0    DIAGFLG           CHECK THE DIAG FLAG
         BEZ      *CMDRTN           RETURN TO COMMAND LEVEL
*
         LW,R15   #PC
         CI,R15   2
         BL       FDPEND2
         LW,R13   FDPERR            SET UP ERROR COUNT
         BAL,R15  CAL                 AND  DISPLAY IT
         NOP      ENDMSG
         NOP      X'4201'
         LW,R13   TMEXEC            SET UP TM'S EXECUTED COUNT
         BAL,R15  CAL                 AND DISPLAY IT
         NOP      TMMSG
         NOP      X'4201'
         LW,R13   FDPIT
         BAL,R15  CAL               PASS MSG
         NOP      PASSMSG           OUTPUT PASS COUNTER
         NOP      X'4206'
FDPEND2  RES
         LI,R15   0
         STW,R15  TMI
         STW,R15  TMEXEC
         STW,R15  TMABORT
         STW,R15  UABORT            CLR ADDR ABORT COUNT
         STW,R15  CNTRLRAB          CLR CONTROLLER ABORT COUNT
         LW,R13   FDPIT
         MTW,1    FDPIT             INC FDP ITERATIONS
         CW,R13   FDPITO            LAST ITERATION
         BL       FDPBGN1A          NO
         BAL,R15  CAL               HALT PROMPT
         NOP      DONEMSG           PRINT: 'COMPLETE'
         NOP      0,2
         B        *CMDRTN
*
***************************************************************
* ABORT - ABORT EXIT, RETURN TO CP-V MONITOR
***************************************************************
*
ABORT    RES
         TYPE     MSG:AB            ABORT MESSAGE
         M:EXIT
*
*
***************************************************************
* ERROR - ERROR REPORTING ROUTINE
***************************************************************
*
*         BAL,15  ERROR
*         NOP     WA(ERRDES)        ERRORS DESCRIPTORS
*
*ERRDES   GEN,8,24     VRBL ITEM CNT, WA(VRBL ITEM LIST)
*         GEN,8,24     SKIP FLAG, WA(RPLCBL ITEM INDX LIST)
*         DATA    WA(LIST OF HEADING INDEXES 0 THRU 7)
*
ERROR    RES
         LCI      0
         STM,R0   REGS
         LW,R7    *REGS+15          GET ERROR DESCRIPTOR PNTR
         LW,R8    0,R7
         LW,R9    1,R7
         LW,R14   2,R7
         LW,R4    PN
         LW,R5    TMI
         LI,R0    1
         LI,R1    0                 RESET SKIP,K,L,M
         LB,R3    R8                GET NMBR OF DATA ITEMS
         AW,R1    R3                SET M
         STW,R8   MBUF              SET UP VI DATA POINTER
         LB,R3    R9                INHIBIT COMM. HDG FLG SET
         CI,R3    X'60'             SKIP=0X OR 1X
         BANZ     ERRS2             NO
         MTW,1    TMERR             INC ERROR COUNTER
         MTW,1    FDPERR
ERRS2    STB,R3   R1                SET SKIP FLAGS
         STW,R1   AUDREGS           SAVE FLAG/ITEM COUNT
         LI,R2    X'3001'           ERROR ID
         LI,R12   KCODES1
         LI,R13   0
         LI,R6    0
         LW,R7    TMERR
         LW,R8    CMOD
         LW,R9    UA
*
***************************************************************
*         ERROR AUDITOR-CONTROLS UPDATING ERROR FILE AND
*         OUTPUTTING THE ERROR LOG
***************************************************************
*
*         R 0=ERROR TYPE INDEX (IDX)
*         R 1=SF,VIC,RIC,0
*         R 2=ERROR IDENTIFIER
*         R 3=BYTE ADDRESS OF ERROR TITLE
*         R 4=PROGRAM NAME
*         R 5=TMI
*         R 6=TM MODE COUNT
*         R 7=TM ERRORS
*         R 8=UNIT NAME
*         R 9=UNIT ADDRESS
*         R10-R11 NOT USED
*         R12=KCODE POINTER         CLASSIFICATION
*         R14=MCODE POINTER         INFORMATION
*         R15=RETURN
*
AUDOR    RES
         MTW,0    INHIBIT           CHECK PRINT INHIBIT
         BNEZ     ERRS3             YES: SKIP PRINTING
         LI,R0    BA(TITLE1)        GET TITLE ADDRESS
         STW,R0   AUDREGS+1
         LB,R15   AUDREGS           SKIP=00 OR 10
         CI,R15   X'60'             00 OR 10
         BANZ     AUDOR2            NO
         LW,R0    AUDREGS+1
         STW,R0   LOGFLG
         LW,R0    ERRCNT
         STW,R0   ERRCNTI           SET UP ERROR LINE COUNT
         MTW,1    SEQUENCE          INCREMENT SEQUENCE
         LI,R0    6
         LI,R1    1
         STB,R0   AUDREGS,R1
         LW,R0    SEQUENCE
         LCI      8
         STM,R4   AUDREGS+7
         M:TIME   TIME,TMS          GET TIME FROM CPV
         AND,R9   XFF00             MASK FOR SECONDS
         SLS,R9   -8                RIGHT JUSTIFY
         LI,R8    0                 CLR R8 IN PREP FOR DIVIDE
         DW,R8    TEN               CONVERT BINARY TO DECIMAL
         OR,R9    XF0               CONVERT DECIMAL TO EBCDIC
         OR,R8    XF0               SAME WITH REMAINDER
         SLS,R9   8                 POSITION 1ST DIGIT
         AW,R9    R8                COMBINE WITH 2ND DIGIT
         AW,R9    X7A0000           ADD ':' CHARACTER
         LB,R8    TIME1             GET LAST MIN CHARACTER
         STB,R8   R9                R9 NOW = 'M:SS'
         STW,R9   TIME1             STORE THIS MESS BACK IN TIME1
         LW,R3    TIME
         LW,R4    TIME1
*                                   LOCATION: TIME  = 'HH:M'
*                                             TIME1 = 'M:SS'
         LCI      5
         STM,R0   AUDREGS+2
AUDOR2   LW,R6    EFSTK
AUDOR3   STW,R6   ELSTK             R6= DESTINATION
         LI,R5    AUDREGS           R5= SOURCE
         LI,R4    1                 R4= WORD COUNT
         LB,R15   AUDREGS           SKIP=00 OR 10
         CI,R15   X'60'             00 OR 10
         BANZ     %+2               NO
         LI,R4    7
         BAL,R15  AUDMOVE
         LI,R8    AUDREGS+7         SET FROM ADD
         LI,R9    LBUFER
         LW,R10   MBUF              M DATA
         LI,R3    -3
         LI,R2    0
AUDOR4   AI,R2    1                 INC POINTER
         LB,R7    AUDREGS,R2        GET K,L OR M
         BE       AUDOR5            EQUALS ZERO
         LI,R4    2
         LW,R5    11,R2             GET CODE POINTER
         BAL,R15  AUDMOVE           PUT CODES IN ERR FILE
         LW,R4    R7                GET COUNT
         LW,R5    7,R2              GET DATA FROM ADD
         BAL,R15  AUDMOVE           PUT DATA IN ERR FILE
AUDOR5   BIR,R3   AUDOR4
         STW,R6   EFSTK             UPDATED POINTER
         STW,R4   0,R6              SET EFSTK END
         LI,R14   1                 SET LOG FLG
         BAL,R15  LOGGER1           LOG IT
         MTW,0    #RC               CHECK RUN CONTROL
         BNEZ     ERRS3             NOT ZERO: GO ON
*
AUDOR9   LI,R2    0
         LI,R3    X'84'             SET HALT INDICATOR
         LB,R15   AUDREGS           IS ANY SKIP BIT SET
         CI,R15   X'10'             MORE TO COME
         BANZ     %+2               YES
         BAL,R15  CCPTTY
*
*
ERRS3    LCI      0
         LM,0     REGS
         B        *REGS+15
*
***************************************************************
* AUDITOR MOVE ROUTINE
***************************************************************
*
*        MOVES THE NUMBER OF DATA ITEMS SPECIFIED IN R4
*        FROM THE STARTING LOCATION SPECIFIED IN R5
*        TO THE STARTING LOCATION SPECIFIED IN R6
*        ..IT ALSO CHECKS FOR ERROR BUFFER OVERFLOW
*
AUDMOVE  CI,R6    ERRFILE+300       IS THE ERROR FILE FULL
         BGE      AUDFULL
         LW,R0    0,R5              FROM DATA
         STW,R0   0,R6              TO DATA
         AI,R5    1                 INC FROM POINTER
         AI,R6    1                 INC TO POINTER
         BDR,R4   AUDMOVE
         B        *R15
*
AUDFULL  LI,R0    -1
         STW,R0   *EFSTK            SET NEW STK INDICATOR
         LW,R6    ERRBUF            RESET ERR FILE POINTER
         STW,R6   EFSTK             RESET ERR FILE POINTER
         B        AUDOR3
*
***************************************************************
***************************************************************
*
LOGGER1  LW,R6    ELSTK             GET EL POINTER
         STW,R15  RETURN6           SAVE RETURN ADDRESS
         LW,R0    0,R6
         STW,R0   AUDREGS           SKIP,K,L,M
         MTW,1    ELSTK
         LB,R15   AUDREGS           SKIP=00 OR 10
         CI,R15   X'60'             00 OR 10
         BANZ     LOGGER4           NO
         MTW,1    ELSTK             POINT TO J DATA
         LW,R0    2,R6              SEQUENCE
         LW,R1    4,R6              IDENT
         LW,R2    1,R6              BA(TITLE)
         STD,R0   SEQUENCE          SET SEQUENCE,IDENT
         LI,R3    0                 SET MSG IND.
         LI,R14   0                 NO WORDS
         LI,R10   1                 HDG SELECTION BIT
         BAL,R15  ELOUT6            OUTPUT TITLE
         LD,R12   JCODES
         LI,R14   5                 WORD COUNT
         LI,R10   2                 HDG SEL. BIT
         LI,R11   BA(ELHDG)
         LI,R2    0                 RESET PR IND.
         BAL,R15  ELOUT             OUTPUT J PART OF ERRMSG
LOGGER4  LI,R0    -3
         LI,R1    0
LOGGER5  AI,R1    1                 INC POINTER
         STW,R0   AUDREGS+9         SAVE COUNTERS
         STW,R1   AUDREGS+10
         LI,R11   0
         LI,R2    0                 RESET PR IND.
         LB,R14   AUDREGS,1         K,L,M
         BE       LOGGER6           VALUE=0
         CI,R1    3                 M PART OF LOG
         BNEZ     LOGGER7           NO
         LB,R15   AUDREGS           GET SF
         CI,R15   X'20'             SKIP=20 OR 30
         BANZ     LOGGER8           YES
         LI,R2    X'F'
         AND,R2   R15               GET PR IND.
LOGGER7  LI,R11   BA(ELHDG)
LOGGER8  LI,R10   4                 GET SELECTOR BIT
         LW,R12   *ELSTK            GET CODES
         MTW,1    ELSTK             INC ERR LOG POINTER
         LW,R13   *ELSTK
         MTW,1    ELSTK
         BAL,R15  ELOUT             OUTPUT K,L,M PART OF ERR MSG
LOGGER6  LW,R0    AUDREGS+9
         LW,R1    AUDREGS+10
         BIR,R0   LOGGER5
         B        *RETURN6          RETURN TO CALLER
*
***************************************************************
***************************************************************
*
ELOUT    STW,R2   AUDREGS+8         SAVE PR
         LW,R9    TPNR0,R2          GET A TPNR FOR ELTPNR+0
         STW,R9   ELTPNR+1          SET UP 1ST TPNR
ELOUT0   LW,R9    ELERRDES          ERR DESCRIPTOR
         LW,R8    Y1540404           BUFFER BEGINS W CR & 3 SPACES
         STW,R8   ELHDG             INITIALIZE ELHDG BUFFER
         LI,R2    -8                MAX FILED COUNTER
         LI,R6    BA(ELHDG)+3       HDG CHAR POINTER
         LI,R7    ELTPNR+2          TPNR UPDATE POINTER
         LI,R4    X'FE'             SKIP IND.
ELOUT2   LB,R5    14,R2             RETREIVE CODE
         BE       ELOUT5            CODE=0
         CI,R5    X'FE'             IS IT A SKIP CODE
         BE       ELOUT4            YES
         STB,R4   14,R2             SET TO SKIP NEXT TIME
         CI,R5    ELHDGSIZ          IS IT A LOCAL CODE
         BL       ELOUT2A           YES
         LI,R5    0                 FORCE ZERO CODE
ELOUT2A  LH,R0    ELTPNRS,5         GET CODES TPNR
         STH,R0   *R7               FORM TPNR
         STB,R8   0,R6              INSERT TRANSITTION BYTE
         AI,R6    1                 INC CHAR POINTER
         LB,R8    *R7               GET NR OF CHARS FOR CODE
         SLS,R5   3
ELOUT3   LB,R0    ELHDGS,R5         MOVE ERR LOG SELECTED HDG
         STB,R0   0,R6              TO ERR LOG HDG
         AI,R5    1                 INC FROM POINTER
         AI,R6    1                 INC TO POINTER
         BDR,R8   ELOUT3            COUNT NR OF CHARS
         STB,R8   0,R6              END MSG
ELOUT4   LW,R0    *ELSTK            MOVE DATA FROM ERR LOG
         STW,R0   ERRTAB-ELTPNR-2,R7 TO THE ERR TABLE
         MTW,1    ELSTK             INC ERR LOG POINTER
         AI,R7    1                 INC ERR TABLE POINTER
         AW,R9    BIT7              INC ERRDES
         LI,R8    X'40'
         AI,R14   -1                DEC MAX WORD COUNTER
         BLE      ELOUT5            FINISHED
         BIR,R2   ELOUT2
ELOUT5   LI,R8    ELOUTENT          FORM DID;1
         LI,R2    BA(OUTBUF)-BA(IBUF)
         LI,R3    X'40'             SET D;X DIRECTIVE IND.
*
*        ENTER HERE FROM LOGGER TO OUTPUT TITLE ONLY
*
ELOUT6   CW,R10   #PC               IS LOG ENABLE SELECTION SET
         BAZ      ELOUT8            NO
         LCI      6
         STM,R10  AUDREGS+11
         LI,R10   0
         LI,R1    LOGDEV
         LB,R15   AUDREGS           SKIP  SET
         CI,R15   X'20'             SKIP=20 OR 30
         BAZ      ELOUT7            NO
         MTW,-1   ERRCNTI           SKIP=20 OR 30,DEC ELC
         BL       %+2               COUNT<0-DONT LOG
ELOUT7   BAL,R15  CCP
         LC       R15               GET PANIC IND. INTO CC'S
         BCS,8    AUDOR9            PANIC EXIT
         LCI      6
         LM,10    AUDREGS+11
         MTW,0    AUDREGS+8         PR=0
         BE       %+2               YES
         MTW,1    ELTPNR+1          INC EXPLAIN COLUMN
ELOUT8   LI,R11   0                 INHIBIT UNIQUE HEADINGS
         CI,R14   0                 WORD COUNTER > 0
         BG       ELOUT0            YES-CONTINUE
         B        *R15
*
*
*
***************************************************************
* REPORT - REPORT MESSAGE ROUTINE
***************************************************************
*
*         BAL,15  *REPORT           X
*         NOP     WA(MESSAGE),X     0=RUN MODE
*                                   1=HALT MODE
*                                   3=MSG MODE
*
*MESSAGE  TEXTS   CR,'MESSAGE TEXT',EM
*
*
REPORT   STW,R15  REPSAVE
         LH,R15   *REPSAVE          GET TTY RUN/HALT IND.
         AI,R15   2                 CONVERT TO CAL NOTATION
         STH,15   REPORT2           NOP 0,1 OR 0,2
         LW,15    *REPSAVE          GET NOP
         AND,15   X201FFFF          CLEAN OFF RUN/HLT IND.
         STW,15   REPORT1
         BAL,15   CAL               OUTPUT REPORT MSG
REPORT1  NOP      0                 OUTPUT MSG TO TTY
REPORT2  NOP      0,1
         B        *REPSAVE
*
         PAGE
********************************************************************
*                        I/O ERROR AND ABNORMAL PROCESSING         *
********************************************************************
*
*
*         ERROR AND ABNORMAL SYSTEMS I/O PROCESSING
*
HELP0    BAL,R15  ERREPORT          FROM M:DDCB
HELP1    BAL,R15  ERREPORT          FROM M:BLIST CAL
HELP2    BAL,R15  ERREPORT          FROM M:BLIST W/NOERR
READERR  BAL,R15  ERREPORT          FROM M:READ TO M:SI
WRITERR  BAL,R15  ERREPORT          FROM M:WRITE TO *OUTDEV
ABNREAD  BAL,R15  ERREPORT          FROM M:READ TO M:SI
ABNWRIT  BAL,R15  ERREPORT          FROM M:WRITE TO *OUTDEV
ERREPORT STW,15   ERREG             LOC OF ABN HANDLER-1
         LB,R14   R10
         SLS,R14  8
         SLS,R10  8
         SLS,R10  -25
         AW,R14   R10
         BAL,R15  HEXTOEBC
         STW,R13  ERRABN+4
         LW,R14   R8
         AND,R14  XFFFF
         AI,R14   -1                POINT TO CAL (R8=CAL+1)
         BAL,R15  HEXTOEBC
         STW,R13  ERRABN+6
         TYPE     ERRABN
         LB,R0    CCPSTK
         OR,R0    BIT24             SET PANIC IND.
         CI,R0    X'50'             CAL4 OR LOG OR DIRECTV
         BANZ     CHKFLG0           YES
         B        HALT+1
*
***************************************************************
***************************************************************
*
Q1ERR    LI,R2    BA(Q1ERROR)       IVALID QUALIFIER
QERR     BAL,R15  MSGOUT
         B        REFIELD
*
Q2ERR    LI,R2    BA(Q2ERROR)       INVALID CHARACTER
         B        QERR
*
Q3ERR    LI,R2    BA(Q3ERROR)       INVALID REQUEST
         BAL,R15  MSGOUT
         LB,R0    CCPSTK            GET FLAGS
         B        SETRUN1
*
Q4ERR    LI,R2    BA(Q4ERROR)       TABLE PROTECT VIOLATION
         B        QERR
*
*
***************************************************************
***************************************************************
*        M:DMOD# COULDN'T FIND I/O UNIT ADDRESS IN UA
*
UAERR    RES
         LW,R14   UA                GET WHATEVER'S IN UA
         BAL,R15  HEXTOEBC          CONVERT LOWER HALF TO TEXT
         STW,R13  BADUA+1           STUFF TEXT IN ERR MESSAGE
         LI,R13   X'40'
         STB,R13  BADUA+1
         TYPE     BADUA             REPORT
         B        INIT4
*
         PAGE
********************************************************************
*                        D I R E C T I V E   R O U T I N E S       *
********************************************************************
*
*
*        BREAK CONTROL ROUTINE
*
BREAK    RES
         CAL1,8   RSTBRK            RESET THE BREAK COUNT
         LI,R4    HALT
         STW,R4   *R1               SET RETURN ADDR IN TCB
         M:TRTN
*
***************************************************************
* DISPLAY - DISPLAY DIRECTIVE ROUTINE
***************************************************************
*
DISPLAY  LI,R1    TTYDEV
ELOUTENT LI,R2    BA(OUTBUF)-BA(IBUF)
         BAL,R15  HDING
         BAL,R15  OUT
         B        *RETURN2
         B        CHKFLG
*
*
***************************************************************
* SELECT - SELECT DIRECTIVE ROUTINE
***************************************************************
*
*        ENTER HERE WITH PARAMETERS Q1 THRU Q4
*        IN REGISTERS R4 THRU R7, RESPECTIVELY.
*        RETURN AT CHKFLG0 IN CCP.
*
FTM      LI,R3    0                 PRESET TMFLAG=FUNCT.
         CI,R4    0                 WAS ANY Q1 ENTERED
         BNEZ     %+2               IF SO, BRANCH
         LI,R4    1                 OTHERWISE,...
         CW,R4    RMAX
         BG       Q3ERR             ERROR IF Q1 IS OUT OF RANGE
         CI,R5    0                 WAS ANY QUALIFIER ENTERED
         BNEZ     %+2               BRANCH IF SO
         LW,R5    R4                SET PARAM 1 = DEFAULT
         CW,R5    R0                TMLAST>TM MAX
         BL       %+2
         LW,R5    R2
         CI,R4    0                 Q1 ENTERED
         BLE      FTM1              NO
         STW,R4   TMI               INITIALIZE TMI
         STW,R4   TMFIRST           Q1 INTO TMFIRST
FTM1     RES
         CW,R5    TMFIRST           IS Q2 LESS THAN Q1
         BGE      %+2               BRANCH IF NOT
         LW,R5    TMFIRST           OTHERWIZE USE Q1
         STW,R5   TMLAST
         CI,R6    0                 Q3 ENTERED
         BLE      %+2               NO
         STW,R6   TMITO             Q3 INTO TM ITERATION COUNT
         CI,R7    0                 Q4 ENTERED
         BLE      %+2               NO
         STW,R7   FDPITO            Q4 INTO FDP ITERATION COUNT
         LI,R0    1
         STW,R0   TMIT              INITIALIZE TM COUNT
         STW,R0   FDPIT             INITIALIZE PASS COUNT
         BAL,R15  CAL
         NOP
         NOP,1    0,2               ISSUE HALT PROMPT
         B        FDPBGN1
*
*
***************************************************************
* HALT - HALT DIRECTIVE ROUTINE
***************************************************************
*
HALT     RES
         LI,R0    0                 CLR INDX
         LI,R1    22                BUFFER SIZE
         STW,R0   IBUF-1,R1         CLEAR THE INPUT BUFFER
         BDR,R1   %-1
         LI,R0    X'84'             BFFR RST & HALT PROMPT
         B        CHKFLG0
*
***************************************************************
* PRINT - PRINT DIRECTIVE ROUTINE
***************************************************************
*
PRINT    LI,R1    LOGDEV
         LW,R15   Q3                Q3>=0
         BE       PRINT1            NO
         CI,R15   X'FFFF0'          MORE THAN 15 LINES
         BAZ      PRINT1            NO
         LI,R15   X'31'             FORCE NEWPAGE
PRINT1   AI,R15   X'C0'
         STW,R15  LPFLG             GET MO
         B        DISPLAY+1
*
***************************************************************
* REPLACE - REPLACE DIRECTIVE ROUTINE
***************************************************************
*
REPLACE  LI,R1    TTYDEV
         LI,R2    0
         BAL,R15  HDING
         BAL,R15  OUT
         LW,R5    MI
         LW,R7    BCI
         LW,R8    CNTRO
         LW,R9    AP
         LW,R6    *AP,R5
         LW,R4    NO
         LW,R15   RETURN2
         B        EXECCCI
         B        CHKFLG            END ACTION ADDRESS
*
***************************************************************
* RUN - RUN  DIRECTIVE ROUTINE
***************************************************************
*
RUN      LB,R0    CCPSTK
         AND,R0   BIT24             KEEP PANIC IND.
SETRUN1  OR,R0    BIT30             FORCE PROMPT
         B        CHKFLG1
*
***************************************************************
* STORE - STORE DIRECTIVE ROUTINE
***************************************************************
*
STORE    LI,R1    TTYDEV
         LI,R2    0
         BAL,R15  HDING
         B        EXECCCI
*
         PAGE
********************************************************************
*        S U B R O U T I N E S
********************************************************************
*
*
*         SET NO,MO,CNTRO TO NI,MI,CNTRI
*
ADVANCE  STW,R4   NO
         STW,R5   MI
         STW,R8   CNTRO
         B        *R15
*
*
***************************************************************
* DOPEN - OPEN DIAGNOSTIC DCB
***************************************************************
*
DOPEN    RES
         DO       SIM=0
         LH,R7    F:DIAG            CHECK IF DCB IS OPEN
         CI,R7    X'20'
         BAZ      %+2               NO
         M:DCLOSE F:DIAG,(PART)     ELSE: CLOSE FIRST
         MTW,0    ELS               IS ERR LOGGING TO BE SUPPRESSED
         BEZ      %+3
         M:DOPEN  F:DIAG,(DEVICE,*UA),;
                  (STATUS,STATUS),(ABN,HELP1)
         FIN
         B        *R15
         M:DOPEN  F:DIAG,(DEVICE,*UA),(NOERR),;
                  (STATUS,STATUS),(ABN,HELP2)
         B        *R15              RETURN TO CALLING ROUTINE
*
*
***************************************************************
* DCLOSE - CLOSE DIAGNOSTIC DCB
***************************************************************
*
DCLOSE   RES
         DO       SIM=0
         LH,R7    F:DIAG            CHECK IF DCB IS OPEN
         CI,R7    X'20'
         BAZ      *R15
         LW,R8    OLDF%TYP          GET FLAGS FROM M:DMOD#
         AND,R8   =X'40000000'       AND MASK OUT PARTIONING BIT
         BCR,2    %+3               DEVICE WAS NOT PARTITIONED: RETURN IT
         M:DCLOSE F:DIAG,(SAME)     ELSE: KEEP IT PARTITIONED
         B        *R15
         M:DCLOSE F:DIAG,(RETURN)   RETURN DEVICE TO THE SYSTEM
         LD,R8    PDEV:YYNDD        GET DCT ENTRY
         STW,R9   MSG:DR+1
         LI,R1    1
         STH,R8   MSG:DR,1
         M:MESSAGE (MESS,MSG:DR)    RETURN DEVICE MESSAGE
         FIN
         B        *R15              RETURN
*
*
***************************************************************
* CAL - CAL SUBROUTINE
***************************************************************
*
*         BAL,15  *CAL     X=         W=           M=
*         NOP     W,X      0 MSGOUT   WA OF MSG    C,D,N
*         NOP     M,Z      1 STORE    LOC OF DESC  LOC OF Q'S
*                          2 DISPLAY  LOC OF DESC  LOC OF Q'S
*         Z=
*         0 TTYDEV-RUN-NO PROMPT    (BITS 12-14 = 0)
*         1 TTYDEV-RUN-PROMPT       (  BIT 14 = 1 )
*         2 TTYDEV-HLT-PROMPT       (  BIT 13 = 1 )
*         4 MSGDEV                  (  BIT 12 = 1 )
*
*         R = DELAY TIME CONSTANT REGISTER
*         NOTE: R CANNOT BE 0 OR AN INDEX REGISTER(1-7).
*         S = 1 RESET STK CAL
*         S = 2,4,8, UNDEFINED
*
CAL      RES
         LCI      0
         STM,R0   CALREGS           SAVE REGISTER CONTENTS
         LW,R1    R15               RESTORE POINTER
         LW,R0    0,R1
         SLS,R0   4                 SHIFT LEFT A HEX DIGIT
         LB,R1    R0                GET SIG BYTE WITH REG IN IT
         AND,R1   XF                MASK FOR REG
         CI,R1    0                 0 ?
         BE       CAL1B             YES-NO DELAY
         LW,R0    *R1               GET THE DELAY VALUE
         STW,R0   WAITFLG
CAL1B    LD,R0    Q1                RESTORE R0 AND R1
         LW,R4    R15               PUT LINK INTO AN INDEX REGISTER
         LW,R2    0,R4              GET THE CAL1 INST.
         LW,R3    1,R4              GET THE NO-OP
         STD,R2   Q1
         LI,R1    TTYDEV
         CW,R3    BIT12             MSG DEVICE SELECTED
         BAZ      %+2               NO-TTYDEV
         LI,R1    LOGDEV
         CI,R2    X'60000'          MSG CAL
         BANZ     DIRCAL            NO-DIRECTIVE CAL
         AND,R2   X1FFFF            KEEP ADDRESS
         SLS,R2   2
         STD,R3   R6                MASK FOR 'N' IN R3
         AND,R7   XFF               GET DISPLACEMENT
         AW,R7    R2                ADD START OF MSG
         AI,R7    -BA(IBUF)         REMOVE PUSH BIAS
         AND,R6   XFF00             GET C & D
         SLS,R6   12
         BAL,R15  PUSH              INSERTS R13 IF R3#0
MSGCAL   LI,R3    X'20'             MSG CAL IND.
         B        CAL1
*
DIRCAL   LI,R8    STORE             POINT TO STORE DIRECTIVE
         CI,R2    X'20000'          STORE
         BANZ     %+2               YES
         LI,R8    ELOUTENT          POINT TO DISPLAY DIRECTIVE
         OR,R8    Y6                SET Q1 & Q2 IND.
         LW,R9    0,R2              GET DESTINATION DISCRIPTOR
         LW,R10   1,R2
         LW,R11   2,R2
         LW,R4    0,R3
         LW,R5    1,R3
         LI,R3    X'50'             EXT DRCTV & BUF RESET IND
CAL1     LH,R0    Q2                GET PROMPT IND.
         OR,R3      0
         BAL,R15  CCP
         LB,R0    R15
         STB,R0   CALREGS+15
         LCI      0
         LM,0     CALREGS
         B        *R15              RETURN TO CALLER
*
*
***************************************************************
* CCP - COMMUNICATION CONTROL MESS
***************************************************************
*        ENTER HERE IF OUTPUT MUST BE TO TTY (CONTROL DEVICE)
*
CCPTTY   RES
         LI,R1    M:UC              FORCE OUTPUT TO M:UC
*
*        ENTER HERE IF OUTPUT DEVICE IS DETERMINED BY CALLER
*
CCP      STB,R3   R15               SAVE FLAG
         STW,R1   OUTDEV
         STW,R15  CCPSTK
         CI,R3    X'40'             EXTERNAL DIRECTIVE
         BAZ      CCP0              NO
         STD,R4   Q1
         STW,R8   DID:1
         STD,R10  DED:2
         B        XDIR              ENTER EXTERNAL DIRECTIVE
*
CCP0     BAL,R15  MSG
*
*        ENTER HERE ON RETURN FROM EXTERNAL DIRECTIVE
*
CHKFLG   LB,R0    CCPSTK            GET FLAG
*
*        ENTER HERE FROM HALT DIRECTIVE
*
CHKFLG0  CI,R0    X'90'             BUFFER RESET IND.
         BAZ      CHKFLG2           NO
*
*        ENTER HERE FROM RUN DIRECTIVE
*
CHKFLG1  LI,R7    STRTBUF
         STD,R7   OCI
CHKFLG2  LW,R11   RUNPRMPT
         AND,R0   X86               FORCE STATEMENT MODE
         CI,R0    4                 HALT
         BAZ      SETFLAG           NO
         LW,R11   HLTPRMPT
SETFLAG  STB,R0   CCPSTK
         STW,R11  IBUF
         LW,R7    CCI               GET CURRENT COUNT
         LI,R2    BA(IBUF)
         BAL,R15  PUSH7             TERMINATE BUFFER
         CI,R0    6                 PRINT THE PROMPT
         BAZ      CCP2              NO
EXECMSG  BAL,R15  MSGOUT
         LW,R12   LO                GET CURRENT LO SETTING
         CW,R12   OLDLO             HAS IT BEEN CHANGED
         STW,R12  OLDLO             SAVE OLD LO
         BE       %+2               BRANCH IF NOT
         BAL,R15  LOCHNG            OTHERWISE CHANGE LO ASNGMENT
         LW,R12   LOCK              GET CURRENT LOCK ENTRY
         CW,R12   OLDLOCK           HAS IT BEEN CHANGED
         STW,R12  OLDLOCK           SAVE OLD LOCK
         BE       %+2               BRANCH IF NOT
         BAL,R15  LCKCHNG           OTHERWISE, CHNG LOCK SETTING
         LW,R12   ELS               GET CURRENT ERROR LOG SETTING
         CW,R12   OLDELS            HAS IT BEEN CHANGED
         STW,R12  OLDELS            SAVE OLD ELS
         BE       CCP2              BRANCH IF NOT
         BAL,R15  DOPEN             OTHERWISE, RE-OPEN DCB W/SAME
CCP2     RES
         LB,R12   CCPSTK            FETCH CONTROL FLAG
         CI,R12   X'54'             IS INPUT REQUIRED
         BAZ      CCP3              NO- RETURN
TTYIN    M:READ   M:SI,(BUF,INBUF),(SIZE,1),;
                  (ERR,READERR),(ABN,ABNREAD)
         LI,R0    0
         STW,R0   WAITFLG           RESET WAIT INDICATOR
         LB,R3    INBUF             FETCH BYTE OF INPUT
         LB,R0    MSGMOD            SYSTEM IN MSG MODE?
         BE       CCP2B             BRANCH IF NOT
         CI,R3    '>'
         BE       RSTMSG
         CI,R3    RMSGMOD           RESET MESSAGE MODE
         BNEZ     CCP2A             NO
*
*        EXIT MESSAGE MODE
*
XITMSG   RES
         LW,R4    OPDEX             GET CURRENT INDEX
         STB,R4   OPMES             SET THE TEXTC COUNT
         M:MESSAGE (MESS,OPMES)     SEND MSG TO OPERATOR
RSTMSG   RES
         LI,R4    0
         STW,R4   MSGMOD            RESET MESSAGE MODE
         STW,R4   OPDEX
         B        HALT              PROMPT FOR INPUT
CCP2A    RES
         LW,R4    OPDEX             GET CURRENT INDEX
         AI,R4    1                 INCREMENT
         CI,R4    71                CHK FOR LENGTH
         BLE      %+4               IF > 71 CHARS,...
         TYPE     OVER               SAY SO AND HALT
         B        XITMSG
         STB,R3   OPMES,R4          STR NEW CHARACTER IN BUFFER
         STW,R4   OPDEX             UPDATE ODPDEX INDEX
         B        CCP3
BUFMSG   RES
         LI,R1    1
         STB,R1   MSGMOD            SET MESSAGE MODE
         LI,R4    -18
         LI,R0    0
         STW,R0   OPDEX             CLEAR INDEX
         STW,R0   OPMES+18,R4       CLEAR INPUT BUFFER
         BIR,R4   %-1
         B        CCP3
*
CCP2B    CI,R3    SMSGMOD           ARE WE STARTING MSG MODE
         BE       BUFMSG            IF SO, BRANCH
         CI,R3    8                 WAS IT AN EOM CHARACTER
         BE       HALT              IF SO, BRANCH
         LW,R7    CCI               PICK UP CHAR COUNT
         STB,R3   IBUF,R7           PUT CHAR INTO BUFFER
         CI,R3    EQUAL             WAS CHARACTER AN '='
         BNE      CCP4              BRANCH IF NOT
         STW,R7   CCI               SAVE BUFFER POINTER
         LW,R7    OCI
         LW,R6    X8240000          HEX
         BAL,R15  PULL              GET THE VALUE IN HEX
         B        Q2ERR
         LB,R0    LASTBYTE          HEX INPUT
         CI,R0    DECIMAL
         BNEZ     %+2               NO
         LW,R6    X8100000          DECIMAL
         STW,R12  WK0               SAVE REMAINDER
         BAL,R15  SPUSH             PUT RESULTS IN BUFFER
LW:13WK0 LW,R13   WK0               GET REMAINDER
         BE       EQUALS1           REMAINDER=0
         BAL,R15  SPUSH             PUSH REMAINDER INTO BUFFER
EQUALS1  LI,R2    BA(IBUF)
         AW,R2    CCI
         B        QERR
CCP4     AI,R7    1                 INCREMENT CCI
         STW,R7   CCI               UPDATE CCI
         CI,R3    ERASE             WAS CHARACTER AN '<'
         BNE      CCP4A             BRANCH IF NOT
REFIELD  LW,R7    OCI               SET CCI=OCI
EXECCCI  STD,R7   OCI
EXECBUF  LI,R2    BA(IBUF)
         BAL,R15  PUSH7             TERMINATE BUFFER
         B        EXECMSG
*
CCP4A    STB,R3   LASTBYTE          SAVE THE LAST BYTE OF INPUT
         LB,R0    CCPSTK            GET FLAGS
         CI,R0    X'50'             STATEMENT MODE
         BANZ     CCP5              IF SO, BRANCH
         CI,R3    X'C8'             WAS AN 'H' INPUT
         BNE      %+3               NOPE
         CI,R0    0                 ARE ANY MODES SET
         BE       HALT              NO- HALT RIGHT NOW
         CI,R3    RETURN            WAS THE CHARACTER A CR
         BNEZ     STMNTM0           BRANCH IF NOT
*
*
***************************************************************
* STMNT - SET UP DIRECTIVES ; EXIT WITH R1-R11
***************************************************************
*
*         R1      TTYDEV
*         R3      WQ2
*         R4-R7   Q1-Q4
*         R8       DID:1 = DIRECTIVE DISCRIPTOR OF SELECTED DIRECTIV
*         R9       DED:1 = DESTINATION DESCRIPTOR
*         R10      DED:2 = ELEMENT LIMIT
*         R11      DED:3 = BYTE ADDRESS OF TABLE HEADINGS
*
         LI,R7    STRTBUF
         STW,R7   OCI               RESET OLD CHARACTER COUNT
         LI,R4    3                 R4=THE NUMBER OF WRDS/ENTRY
         LI,R5    0                 LOC OF NEXT TABLE
         LI,R6    DIRTAB            LOC OF DIRECTIVE TABLE
         BAL,R15  SCAN              SCAN TABLE FOR DIRECTIVE
         B        QERR              RETURN HERE IF NO MATCH
         LI,R9    MEMDES            GET LOC OF MEMORY DESCRIP
         LW,R8    *APTO             END ACTION POINTER
         STW,R8   DID:1
         STW,R9   APTO              ANTICIPATE NO DESTINATION
         BGE      STMNT0            NO DESTINATION EXPECTED
         LW,R7    CCI
         AI,R7    1
         STW,R7   OCI
         LI,R4    5                 WORDS/ENTRY
         LI,R5    0                 LOC OF NEXT TABLE
         LI,R6    DESTAB            LOC OF DESTINATION TABLE
         BAL,R15  SCAN
         B        QERR
STMNT0   RES
         MTB,0    DID:1             CHECK IF PARAMTERS REQUIRED
         BEZ      *DID:1            NO: BRANCH TO ROUTINE
         LW,R3    APTO
         LW,R9    0,R3
         LW,R10   1,R3
         LW,R11   2,R3
         STD,R10  DED:2
         LW,R6    X8240000          8 DIGITS HEX
         LW,R7    CCI
         LB,R10   IBUF,R7
         LI,R4    -5
         AI,R7    -1                POINT AT LAST DELIM-1
STMNT1   LI,R13   0                 PRESET QUAL. OR CONS.=0
         CI,R10   RETURN            WAS DELIMETER A CR.
         BE       STMNT2            YES-DONT PULL NEXT ENTRY
         AI,R7    1
         STW,R7   OCI
         BAL,R15  PULL              GET Q2 IN HEX
         B        Q2ERR
STMNT2   CW,R8    BIT5,R4           IS IT A QUALIFIER
         BAZ      STMNT3            NO-DONT CHECK IT
         CI,R13   0                 IS IT LESS THAN 0
         BL       Q1ERR             YES
         CI,R4    1                 Q2 OR Q4
         BAZ      STMNT3            NO
         CW,R13   Q0+4,R4           Q0>-1,Q2>Q1 OR Q4>Q3
         BGE      STMNT3            YES
         CW,R8    BIT8,R4           R Q1&Q2 RELATED TO Q3&Q4
         BANZ     STMNT3            BRANCH IF NOT
         AW,R13   Q0+4,R4           SET Q2 OR Q4=Q2+Q1 OR Q4+Q3
         AI,R13   -1                SET QEVEN=QEVEN+QODD-1
STMNT3   STW,R13  Q0+5,R4
         BIR,R4   STMNT1            GET ALL 4 OF THEM
         LB,R0    CCPSTK
         BNEZ     %+2               NOT 0
         LI,R0    2                 FORCE RUN PROMPT
         OR,R0    BIT27             FORCE DATA MODE
         STB,R0   CCPSTK
         LI,R1    TTYDEV
*
*
***************************************************************
* XDIR - EXTERNAL DIRECTIVE HANDLER
***************************************************************
*
XDIR     LW,R3    Q0
         LD,R4    Q1                GET THE DIRECTIVE ADDRESS
         LD,R6    Q3
         B        *DID:1
STMNTM0  CI,R3    PROMPT
         BE       SETRUN1
         CI,R3    EOR
         BE       STMNTM1           YES
         CI,R3    DLIMETR
         BNEZ     CCP3
STMNTM1  STW,R7   OCI
         BAL,R15  PUSH7             TERMINATE BUFFER
CCP3     MTW,0    WAITFLG           DELAY ?
         BEZ      CCP3A             NO
         MTW,-1   WAITFLG           YES-DECREMENT COUNT
         BNE      CCP3A             LEAVE CCP COUNT UNFINISHED
         LI,R15   4
         STW,R15  CCI               RESET CHARACTER COUNT INDEX
         B        *CCPSTK
*
CCP3A    LB,R0    CCPSTK
         CI,R0    X'54'             IN RUN  MODE
         BANZ     CCP2              NO
         B        *CCPSTK           RETURN TO CALLER
*
CCP5     CI,R3    RETURN
         BE       CHKFLG
* TO IMPLEMENT NL AS A TERMINATOR, REPLACE THE ABOVE LINE WITH
* THE BELOW TWO (ASTERISKED) LINES, SEE ALSO THE INSERT
* INDICATED AT DATAIN0+5.
*        BNE      %+2               YES
*        LI,R3    DLIMETR           FORCE A COMMA
         CI,R3    PROMPT
         BE       HALT              YES
         CI,R3    EOR
         BE       DATAMOD           YES
         CI,R3    DLIMETR
         BNEZ     CCP3              NO
DATAMOD  LW,R7    OCI
         BAL,R15  PULL              GET LAST FIELD
         B        Q2ERR
         LW,R11   R7                SAVE ORIG. CCI
         LW,R7    OCI
         LW,R14   R13
         BAL,R15  LDTBL             GET VALUE TO BE CHANGED
         CI,R3    0                 ANY CHARS INPUTTED
         BE       DATAIN0           NO
         CI,R10   EOR               SEMI COLON
         BNEZ     %+2               NO
         EOR,14   R13               EXCLUSIVE OR
         LW,R13   R14               GET VALUE TO BE STORED
*
*         STORE TABLE ELEMENT FROM R13. RETURN WITH VALUE IN R14.
*
         CW,R6    BIT8              WRITE PROTECTED?
         BANZ     Q4ERR             YES: ABORT
         LI,R15   X'FFFF'
         AND,R15  R6                GET TABLE ENTRY
         CI,R6    X'60000'          BYTE ADDRESSING?
         BANZ     %+2               NO
         STB,R13  *R15,R4
         CI,R6    X'20000'          HALF WORD ADDRESSING?
         BAZ      %+2               NO
         STH,R13  *R15,R4
         CI,R6    X'40000'          WORD ADDRESSING?
         BAZ      %+2               NO
         STW,R13  *R15,R4
DATAIN0  BAL,R15  PUSH              PUSH IT BACK IN
         STD,R7   OCI               UPDATE OCI=CCI
         LI,R2    BA(IBUF)
         LCW,R15  R7                LOAD MINUS R7 INTO R15
         AW,R11   R15
         BGE      DATAIN1           YES-REFIELD
* PART OF THE CHANGE DESCRIBED AT CCP5.
*        CI,R10   X'D'              WAS NEW LINE ENTERED
*        BE       CHKFLG            IF SO, TERMINATE.
         LI,R2    BA(TICKS)+9       POINT TO SPACE AFTER TICKS
         AW,R2    R11               SELECT C-CCI TICKS
DATAIN1  BAL,R15  UPDATE
         B        EXECBUF+1
         CW,R4    NE                LAST FIELD?
         BG       CHKFLG            YES
         BAL,R15  ADVANCE
         B        SETCNTR           (IN SET)
*
*
***************************************************************
* EBCTOHEX - EBCDIC TO HEXADECIMAL CONVERTION
***************************************************************
*
*        CONVERTS TEXT FOR X'0-F' IN R13
*        TO RIGHT JUSTIFIED PACKED HEX,
*        AND PUTS IT BACK IN R13.
*
*        USES R5 & R6 BUT RESTORES THEM.
*        IGNORES NULL BYTES, I.E., X'00'
*        LINK REG IS R15
*
EBCTOHEX LCI      2
         STM,R6   ETHREGS           SAVE REGS 5,6 & 7
         LI,R7    3                 SET INDEX & LOOP CNT TO TREE
ROUND    LB,R6    13,R7             GET THE TO-BE CONVERTED BYTE
         BEZ      ROUND2            DO NOT CONVERT IF NULL BYTE
         SW,R6    XB7               SEE IF ITS X'C1' THRU X'C6'
         CI,R6    X'10'             WELL,...WAS IT
         BL       %+2               BRANCH IF NOT
         LB,R6    13,R7             RESTORE R6 TO EBCDIC
         AND,R6   XF                YES IT WAS, & YES I SHOULD BRAN
ROUND2   STB,R6   13,R7             STR IT BACK INTA R13
         AI,R7    -1                DECREMENT THE INDEX/LOOP COUNT
         BSNE     ROUND             LOOP UNLESS R7 GOES NEGATIVE
         LW,R6    R13               GET UNPACKED HEX
         AND,R6   XF                PACK 1ST DIGIT
         STW,R6   R7
         LW,R6    R13               PACK 2ND DIGIT
         AND,R6   XF00
         SLS,R6   -4
         AW,R7    R6
         LW,R6    R13               PACK 3RD DIGIT
         AND,R6   XF0000
         SLS,R6   -8
         AW,R7    R6
         LW,R6    R13               PACK 4TH & LAST DIGIT
         AND,R6   XF000000
         SLS,R6   -12
         AW,R7    R6
         LW,R13   R7                PUT PACKED # BACK IN R13
         LCI      2
         LM,6     ETHREGS           RESTORE THEM REGISTRAWRS
         B        *R15              RETURN,RETURN,RETURN.
*
*
***************************************************************
* LCKCHNG,LOCHNG - CHECK FOR CHANGE OF LOCK OR LO DEVICE
***************************************************************
*
LCKCHNG  RES
         LH,R7    F:DIAG
         CI,R7    X'20'             HAS THE DCB BEEN OPENED
         BAZ      *R15              IF NOT, RETURN TO THE CALLER
         LW,R12   LOCK              LOAD CURRENT LOCK SETTING
         BEZ      %+3               BRANCH IF ZERO, (UNLOCK)
         M:LOCK   YES               NO, SET LOCK
         B        *R15              RETURN TO CALLER
         M:LOCK   NO                YES, RESET LOCK
         B        *R15              RETURN TO CALLER
*
LOCHNG   LI,R13   M:LO              SET DCB NAME TO LO
         STW,R13  DCBNAME
         LH,R11   *DCBNAME          GET 1ST HALF OF 1ST DCB WORD
         CI,R11   X'20'             IS DCB OPEN; (BIT 10 = 1)
         BAZ      %+2               BRANCH IF NOT, AND OPEN IT
         M:CLOSE  *DCBNAME          OTHERWISE, CLOSE IT 1ST
         CW,R12   #UC               WAS THE DCB ASSIGNED TO M:UC
         BNEZ     %+3               BRANCH IF NOT
         M:OPEN   *DCBNAME,(DEVICE,'UC')
         B        *R15
         CW,R12   #OC               WAS THE DCB ASSIGNED TO M:OC
         BNEZ     %+3               BRANCH IF NOT
         M:OPEN   *DCBNAME,(DEVICE,'OC')
         B        *R15
         CI,R12   'LP'              CHECK IF DCB WAS ASSIGNED TO LP
         BNE      *R15              BRANCH IF NOT
         M:OPEN   *DCBNAME,(DEVICE,'LP')
         B        *R15              RETURN TO CALLER
*
*
***************************************************************
* HDING - HEADING SUBROUTINE
***************************************************************
*
*         HEADING SETS ADDRESS,NO,NE,MO,ME,CNTRO,AP,MI
*
HDING    STW,R15  RETURN3
         CW,R8    BIT0              Q0
         BAZ      HDING0            NO
         CI,R3    0                 Q0=0
         BE       HDING0            YES
         LW,R6    R3                SET MO=Q0
         LW,R7    R3                SET ME=Q0
         OR,R8    Y18               FORCE SELECTION OF Q3,Q4
HDING0   LI,R3    -4
HDING1   LI,R0    0
         LI,R15   1                 MIN Q3,4
         LB,R14   R9                MAX Q3,4
         CI,R3    2                 Q3,4
         BANZ     HDING2            YES
         LI,R15   0                 MIN Q1,2
         LW,R14   DED:2             MAX Q1,2
HDING2   CW,R8    BIT5,R3           QUALIFIER EXPECTED
         BANZ     %+2               YES
         STW,R0   8,R3              DEFAULT TO ZERO
         CW,R14   8,R3              QUALIFIER > MAX.
         BG       %+2               NO
         STW,R14  8,R3
         CI,R3    1                 Q2 OR Q4
         BAZ      HDING3            NO
         LW,R0    8,R3
         AW,R0    7,R3              Q1,2 OR Q3,4 = 0
         BNEZ     HDING3            NO
         STW,R14  8,R3              FORCE Q2 OR Q4 MAX
         STW,R15  7,R3              FORCE Q1 OR Q3 MIN.
HDING3   BIR,R3   HDING1
         LI,R15   X'15'
         STB,R15  IBUF,R2
         AI,R2    1
         LW,R8    R4                INITIALIZE CNTRO WITH Q1
         LCI      8
         STM,R2   ADDRESS           SET ADDRESS,NO,NE,MO,ME,AP
         EOR,2    ONES
         AI,R2    1
         STW,R2   NADDRESS          FORM -ADDRESS
         STW,R1   OUTDEV
         LW,R2    DED:3             BA OF HEADING
         CI,R0    0                 FULL Q3 & Q4
         BNEZ     %+2               NO
         BAL,R15  MSG
SETCNTR  LW,R13   CNTRO
         LW,R7    ADDRESS           GET BEGINNING OF BUFFER
         LW,R6    *AP               COUNTER POINTER
         BE       %+2               NO
         BAL,R15  PUSH              ENTER COUNTER VALUE
         LW,R9    AP
         LW,R8    CNTRO
         STW,R7   BCI
         LW,R4    NO
         LW,R5    MO
         STW,R5   MI
         LW,R6    *AP,R5            GET ARRAY POINTER
         B        *RETURN3
*
*
***************************************************************
* HEXTOEBC - HEXADECIMAL TO EBCDIC CONVERTION
***************************************************************
*
*        CONVERTS RIGHT 4 HEX DIGITS IN R14 TO EBCDIC IN R13
*
HEXTOEBC RES
         STW,R4   4SURE             SAVE R4
         LI,R13   0                 BE SURE OUTPUT R IS CLR
         LI,R4    3                 SET LOOP COUNT FOR 3 BYTES
ONEBYTE  LW,R12   R14               PUT VALUE IN  A TEMP R
         SLS,R14  -4                SHIFT IN NEXT HEX CHAR
         AND,R12  XF                MASK FOR RIGHTMOST HEX DIGIT
         CI,R12   9                 IS IT GREATER THAN 9
         BG       %+3               IF SO, BRANCH AND ADD X'B7'
         AI,R12   X'F0'             OTHERWISE ADD X'F0'
         B        %+2
         AI,R12   X'B7'             ADDING X'B7' CONVERTS A THRU F
         STB,R12  13,R4             STORE CONVERTED BYTE, INDEXED
         AI,R4    -1                DECREMENT BYTE POSITION INDEX
         BCR,1    ONEBYTE           LOOP FOR NEXT BYTE
         LW,R4    4SURE             3 DIGITS CONVERTED, RESTORE R4
         B        *R15              RETURN TO CALLER
*
*
***************************************************************
* LDTBL - LOAD TABLE ELEMENT IN R13
***************************************************************
*
LDTBL    STW,R15  RETURN1
         LI,R15   X'FFFF'
         AND,R15  R6                GET TABLE ENTRY
         CI,R6    X'60000'          IS IT BYTE ADDRESSING
         BANZ     %+3               BRANCH IF NOT
         LB,R13   *R15,R4
         B        LDTBL1
         CI,R6    X'20000'          HALFWORD ADDRESSING
         BAZ      %+4               BRANCH IF NOT
         LH,R13   *R15,R4
         AND,R13  XFFFF
         B        LDTBL1
         LW,R13   *R15,R4           WORD ADDRESSING
LDTBL1   RES
         B        *RETURN1
*
*
***************************************************************
* MSG - MESSAGE PRINT ROUTINE
***************************************************************
*
*        R1 = DCB ADDRESS
*        R2 = BYTE ADDRESS OF MESSAGE
*
MSG      RES
         LCI      0
         STM,0    SAVREGS1          SAVE REGISTERS
         CI,R2    X'40'             IS MSG WORD ADDRESS > 16
         BL       MSGXIT
         STW,R1   OUTDEV
         STW,R2   MSGWK0            SAVE MSG ADDRESS
         CI,R1    M:LO              IS OUTPUT TO M:LO
         BNE      MSG2B             NO- MUST BE TO M:SI
         LW,R3    LO                YES- FETCH DEVICE TYPE
         CW,R3    #UC               IS DEVICE ASNMNT TO U.C.
         BE       MSG7              YES- DO TY OUTPUT
         B        MSG1              NO- OUTPUT ON LP
*
MSG2B    LW,R3    SI                FETCH SOURCE DEVICE TYPE
         CW,R3    #CR               IS IT A CARD READER
         BE       MSGXIT            YES- INHIBIT OUTPUT
MSG7     RES
         BAL,R15  MSGOUT
MSGXIT   RES
         LCI      0
         LM,0     SAVREGS1          RESTORE REGISTERS
         B        *R15
*
MSG1     LW,R0    LPFLG             IS THER A FORMAT CHAR
MSG1B    LB,R12   0,R2              GET A BYTE
         BE       MSGXIT            ITS ZERO-END MESSAGE
         CI,R12   NEWPAGE
         BNEZ     MSG1E             NOT A NEW PAGE
MSG1C    LI,R0    X'F1'             SET NEW PAGE
MSG1D    AI,R2    1                 INC ADD.
         B        MSG1B             GO GET ANOTHER BYTE
*
MSG1E    CI,R12   X'15'
         BNEZ     MSG3              NOT A CR
         CI,R0    X'CF'             BIGGER THAN 16 CR'S OR NP
         BGE      MSG1C             YES-FORCE NEW PAGE
         BANZ     %+2               MUST BE A CX
         LI,R0    X'BF'             FORCE A C0
         AI,R0    1
         B        MSG1D
* PRINT SPECIFIED PORTIONS OF ERROR LOG
*
MSG3     OR,R0    XC0               FORCE SINGLE CR IF LPFLG=0
         STB,R0   LPBUF             STORE FORMAT BYTE
         STW,R2   MSGWK0
         LI,R3    0                 SET LPBUF CHAR COUNT=1
MSG4     LB,R12   0,R2              GET CHAR
         BE       MSG5              END MESSAGE
         CI,R12   NEWPAGE
         BE       MSG5              YES
         CI,R12   X'15'
         BE       MSG5              YES
         AI,R2    1                 INC MSG ADDRESS
         AI,R3    1                 INC LPBUF COUNT
         CW,R3    LIMIT             IS THE BUFFER NEAR FULL
         BL       MSG4              NO
         CI,R12   X'40'             IS THERE A SPACE
         BNE      MSG4
*
MSG5     LI,R0    0
         STW,R0   LPFLG             RESET THE LP FLG
         CI,R3    X'FFFF'           ANY CHARS
         BAZ      MSG1B             NO-START NEXT LINE
         LB,R4    LPBUF
         CI,R4    X'C1'
         BL       MSG6
         M:WRITE  *OUTDEV,(BUF,LPBUF),(SIZE,1),;
                          (ERR,WRITERR),(ABN,ABNWRIT)
MSG6     LW,R5    R3
         LW,R4    MSGWK0
         LW,R10   R4
         AND,R10  X3                MASK FOR BYTE PORTION
         SLS,R4   -2                CONVERT BYTE TO WORD ADDRESS
         M:WRITE  *OUTDEV,(BUF,*R4),(SIZE,*R5),;
                          (ERR,WRITERR),(ABN,ABNWRIT),(BTD,*R10)
         B        MSG1
*
*
***************************************************************
* MSGOUT - MSG OUTPUT ROUTINE : R2 = BYTE ADDRESS
***************************************************************
*
MSGOUT   LCI      0
         STM,0    SAVREGS0          SAVE REGISTERS
         CI,R2    X'40'             IS BYTE ADDR. > 40
         BL       MSGOUT3           NO- EXIT
         STW,R2   R7
         STW,R2   8
         LI,R3    0                 CLR R3 FOR COMPUTING BC
MSGOUT1  LB,R9    0,7               FETCH BYTE FROM MSG
         BE       MSGOUT2           BRNCH IF BYTE=0 (LST BYTE)
         AI,R7    1                 INCREMENT BYTE INDEX
         AI,R3    1
         B        MSGOUT1           LOOP FOR NXT BYTE
MSGOUT2  AND,R8   X3                MASK FOR BYTE ADR. PORTION
         SLS,R2   -2                SHIFT BYTE ADDRESS
         M:WRITE  M:UC,(BUF,*R2),(SIZE,*R3),;
                          (ERR,WRITERR),(ABN,ABNWRIT),(BTD,*R8)
MSGOUT3  RES
         LCI      0
         LM,0     SAVREGS0          RESTORE REGISTERS
         B        *R15
*
*
***************************************************************
* OUT - OUT SUBROUTINE
***************************************************************
*
*         MOVES TABLE ELEMENT APM+N FROM TABLE, CONVERTS
*         VALUE VIA 'D' AND PUTS THE VALUE INTO THE BUFFER
*         AT BYTE CCI. WHEN A LINE FULL OF INFO HAS BEEN
*         INSERTED, THE LINE IS OUTPUT ON 'OUTDEV'.
*
OUT      STW,R15  RETURN4
OUT1     BAL,R15  LDTBL             GET ELEMENT APM+N
         BAL,R15  PUSH              PUT INTO BUFFER
         BAL,R15  UPDATE
         B        OUT1
         B        OUT3
         BAL,R15  OUTLINE
OUT4     MTW,1    RETURN4
         B        *RETURN4
*
OUT3     BAL,R15  OUTLINE
         CW,R4    NE                DONE?
         BG       OUT4              YES
         BAL,R15  ADVANCE
         B        SETCNTR
*
*         OUTPUTS THE IBUF   ON THE 'OUTDEV' DEVICE.
*
OUTLINE  STW,R15  RETURN2
         LW,R1    OUTDEV
         LI,R2    BA(IBUF)-1
         AW,R2    ADDRESS           COMPUTE OUTPUT BUFFER ADD
         BAL,R15  MSG
         B        *RETURN4
*
*
***************************************************************
* PUSH - PUSH SUBROUTINE
***************************************************************
*
*         PUSHES THE CONTENTS OF R13 INTO THE BUFFER AND
*         PRECEEDS THE VALUE WITH 'S' SPACES.
*         R0,R3,R7,R12,R13,R14,R15
*
SPUSH    LI,R14   -1                SPPRESS LEADING ZEROS
         B        %+2
*
PUSH     LI,R14   0                 INHIBIT LEADING ZERO SUPRESS
         STW,R14  SUPRESS
         CW,R6    TIMENTRY          ARE WE PUSHING THE TIME
         BE       PUSH0             YEP, -PUSH THE DATA AS IS
         CW,R6    TIMENTRY+1        2ND WRD OF TIME MAYBE
         BNEZ     PUSH0A            NOPE, -PROCEED AS USUAL
PUSH0    LB,R12   13,R3             GET A BYTE OF R13
         STB,R12  IBUF,R7           PUT IT INTO THE BUFFER
         MTW,1    R7                INCREMENT THE STORE INDEX
         AI,R3    1
         CI,R3    4                 HAS THE FULL WRD BEEN STORED
         BE       PUSH7             YEP, -TERMINATE
         B        PUSH0             OTHERWISE, LOOP
PUSH0A   LB,R3    6                 GET C
         BE       PUSH5             C=0
         LI,R14   EBCDICS-1         ADDRESS OF POWERS OF 1
         CW,R6    X700000           D=0(EBCDIC)
         BAZ      PUSH8             YES
         LI,R14   SIXTEENS-1        ADDRESS OF POWERS OF 16
         CW,R6    BIT10             D=2(HEX)
         BANZ     PUSH1             YES
         LI,R14   TENS-1            ADDRESS OF POWERS OF 10
         CW,R6    BIT9              D=4(ADDRESS) OR 5(TIME)
         BAZ      PUSH1             NO
         LI,R14   ADRS-1            ADDRESS OF POWERS OF ADDRESS
PUSH1    AND,R13  XF-1,R3           MASK OFF UNWANTED BITS
         LB,R3    6                 GET C
PUSH2    LI,R12   POINT             ANTICIPATE ADDRESS FORMAT
         CI,R14   ADRS-1            IS IT
         BE       %+2               YES
         LI,R12   DECIMAL           TIME FORMAT
         LW,R0    *R14,R3           DIVISOR=0
         BLE      PUSH3B            YES
         LI,R12   0
         DW,R12   R0
         LW,R0    R12
         LW,R12   R13
         LW,R13   0
         CW,R6    X700000           EBSIDIC CHAR?
         BAZ      PUSH3A            YES
         CI,R12   0                 CHAR=0
         BNEZ     PUSH2A            NO
         LW,R0    SUPRESS           SUPRESS LEADING ZEROS
         BL       PUSH4             YES-PUSH IN A SPACE
PUSH2A   CI,R12   9                 GREATER THAN 9?
         BG       PUSH3             YES
         AI,R12   X'39'
PUSH3    AI,R12   X'B7'
PUSH3A   LI,R0    0                 RESET SUPPRESS FLAG
         STW,R0   SUPRESS
         CI,R12   0                 CHAR=0
         BNEZ     %+2               NO
         LI,R12   X'40'             MUST BE EBCDIC, FORCE BLANK
PUSH3B   STB,R12  IBUF,R7           INSERT CHAR INTO BUFFER
         AI,R7    1                 INCRMENT CCI
PUSH4    BDR,R3   PUSH2
         CI,R0    0                 STILL SUPPRESSING ZEROS
         BL       PUSH2A            YES-GO PUSH A ZERO(F0)
PUSH5    CI,R15   MSGCAL            FROM MESSAGE CAL
         BE       *R15              YES-GET OUT
         LI,R12   SPACE
         STB,R12  IBUF,R7
         AI,R7    1                 INCRMENT CCI
*
PUSH7    LI,R12   0
         STB,R12  IBUF,R7           TERMINATE CHAR.
         B        *R15
*
PUSH8    AW,R3    R3                DOUBLE THE COUNT
         B        PUSH1
*
*
***************************************************************
* PULL - PULL SUBROUTINE
***************************************************************
*
*         PULLS A FROM THE IBUF   AT BYTE CCI AND CONVERTS
*         THE VALUE VIA 'D' IN R1 AND PUTS THE RESULTS IN R13.
*
*        R1 = CONVERTION CODE
*        R7 = IBUF   BYTE INDEX ( AS IN CCI OR OCI)
*        R15= LINK ADDRESS
*
PULL     STW,R15  RETURN5           SAVE RETURN
         LW,R1    R6                GET TPNR
         LI,R3    0
         LW,R0    LW:13WK0
PULL0    STW,R0   OPERATOR          PRESET OPERATOR TO LW,13
         LW,R0    LW:13WK0
         STW,R13  WK0               PRESET VALUE=0
         LI,R13   0
         CW,R1    X700000           EBSDIC
         BANZ     %+2               NO
         LW,R13   ELHDGS            GET ALL BLANKS
PULL1    LB,R10   IBUF,R7           GET BYTE CCI
         CI,R10   RETURN
         BE       PULL5             YES
         CI,R10   DLIMETR
         BE       PULL5             YES
         CI,R10   EOR
         BE       PULL5             YES
         CI,R10   EQUAL
         BE       PULL8
         AI,R7    1                 INC BYTE POINTER
         AI,R3    1                 INCRMENT DIGIT COUNTER
         CW,R6    BIT12             BYTE STRING
         BANZ     PULL1             YES-IGNORE INPUTS BUT COUNT
         CI,R10   SPACE
         BE       PULL1             YES-SKIP IT
         CI,R10   POINT
         BE       PULL4             YES
         CI,R10   DECIMAL
         BE       PULL6             YES
         CI,R10   MINUS
         BE       PULL7             YES
         CI,R10   MULTIPLY
         BE       PULL7+1
         CI,R10   DIVIDE
         BE       PULL7+2
         CI,R10   PLUS
         BE       PULL7+3
         AND,R1   X700000           EBSIDIC FORMAT?
         BE       PULL3             YES
         CI,R10   X'30'             A THRU F
         BANZ     %+2               NO
         AI,R10   X'39'             FORM FA THRU FF
         CI,R10   X'F0'             LESS THAN 0
         BL       *RETURN5          YES-ERROR
         CI,R10   X'FF'             GREATER THAN F
         BG       *RETURN5          YES-ERROR
         LI,R14   16                ANTICIPATE HEX
         CW,R1    BIT11             IS IT DECIMAL
         BAZ      PULL2             YES
         LI,R14   10
         CI,R10   X'F9'             GREATER THAN 9
         BG       *RETURN5          YES-ERROR
PULL2    AND,R10  XF                F
         MW,R13   R14
PULL2A   AW,R13   R10
         B        PULL1
*
PULL3    SLS,R13  8
         B        PULL2A
*
PULL4    SLS,R13  2
         LW,R1    BIT10             FORCE HEX
         B        PULL7+3           FORCE AN ADD
*
PULL5    CW,R1    BIT9              D=4
         BNEZ     PULL8             NO
         SLS,R13  2
PULL8    BAL,R14  PULL9             PERFORM LAST OPERATION
         MTW,1    RETURN5
         B        *RETURN5
*
PULL6    LW,R1    BIT11             SET DECIMAL MODE
         B        PULL1
*
PULL7    AW,R0    BIT7
         AW,R0    X1100000
         AW,R0    X5F00000
         AW,R0    YFE               FORM AW,13 WK0
         LI,R14   PULL0             SET RETURN TO PULL0
*
*
*
PULL9    LW,R12   WK0
         STW,R13  WK0               EXCHANGE VALUE FOR 0
         LW,R13   R12               GET ORIG VAL
         LI,R12   0
OPERATOR PZE
         B        *R14
*
*
***************************************************************
* SCAN - SCAN FOR DIRECTIVES OR DESTINATIONS
***************************************************************
*         SKIPS ON EXIT IF ONLY ONE MATCH.
*
SCAN     STW,R15  RETURN4
         STW,R7   CCI
         STW,R5   NE                NEXT TABLE ADDRESS
         LI,R5    0                 COUNTS THE NR OF MATCHES.
SCAN0    STW,R6   NO                LOC OF CURRENT ENTRY
         LW,R3    0,R6              END OF TABLE
         BE       SCAN3             YES
         LI,R6    0                 RESET TABLE BYTE COUNT
         LW,R7    OCI               OLD BUFFER POINTER
SCAN1    LB,R10   IBUF,R7
         CI,R10   DLIMETR
         BE       SCAN5             YES
         CI,R10   EOR
         BE       SCAN5             YES
         CI,R10   DECIMAL
         BE       SCAN5             YES
         CI,R10   RETURN
         BNE      SCAN2             BRANCH IF NOT A CARIAGE RETURN
         CI,R7    4                 IF A CR, WAS IT 1ST CHARACTER
         BE       HALT              IF SO, PROMPT FOR INPUT
         B        SCAN5             IF NOT, PROCEED WITH SCAN
*
SCAN2    CI,R10   SPACE
         BE       SCAN2A
         CB,R10   *NO,R6            TABLE BYTE=BUFFER BYTE?
         BNEZ     SCAN7             NO-GET NEXT ENTRY
         AI,R6    1                 INCREMENT TABLE POINTER
SCAN2A   AI,R7    1                 INCREMENT BUFFER POINTER
         B        SCAN1
*
SCAN3    LI,R0    0
         LW,R6    NE                WERE DONE IF NE=0
         STW,R0   NE                SET IT TO ZERO
         BNEZ     SCAN0             NOT DONE YET
         LI,R2    BA(SELERR)
         CI,R5    1
         BL       *RETURN4          NO MATCHES(R5<1)
         BE       SCAN8             EXACTLY ONE MATCH(R5=1)
         BAL,R15  SCANOUT           LAST OF MANY MATCHES
         LW,R7    CCI
         B        EXECBUF
*
SCAN5    STW,R7   CCI
         CI,R5    0                 FIRST MATCH?
         BE       SCAN6             YES
         BAL,R15  SCANOUT           OUTPUT ENTRYS NAME
SCAN6    AI,R5    1                 INCREMENT MATCH COUNT
         LW,R6    NO                BA OF CURRENT ENTRY
         STW,R6   APTO
SCAN7    LW,R6    NO                BA OF CURRENT ENTRY
         AW,R6    R4                INC BY ENTRY SIZE IN BYTES
         B        SCAN0
*
SCAN8    MTW,2    APTO              SET DISCRIPTOR POINTER
         MTW,1    RETURN4
         B        *RETURN4
*
*
***************************************************************
* SCANOUT - MOVE ENTRY NAME IN SCANBUFFER AND OUTPUT IT
***************************************************************
*
SCANOUT  STW,R15  RETURN5
         LW,R2    APTO              GET WORD ADD OF TEXT
         LW,R3    1,R2
         LW,R2    0,R2              FORM BYTE ADD
         STD,R2   SCANBUF
         LI,R2    BA(SCANBUF)-1
         BAL,R15  MSGOUT            OUTPUT ENTRY NAME
         B        *RETURN5
*
*
***************************************************************
* UPDATE - UPDATE NI,MI,APTI,CINC,CNTRI; ENTER FROM 'OUT' OR 'DATAIN1'
***************************************************************
*
UPDATE   CI,R9    X'20000'          HORIZONTAL FORMAT?
         BANZ     UPDATE1           YES
         AI,R5    1                 INCREMENT MI
         LW,R6    *AP,R5            GET TABLE POINTER
         CW,R5    ME                MI>ME
         BLE      *R15              NO
UPDATE1  AI,R8    1                 INCREMENT CNTR
         AI,R4    1                 INCREMENT NI
         CI,R9    X'20000'          VERTICAL FORMAT?
         BAZ      UPDATE2           YES
         LB,R10   R6                GET CHAR COUNT(C)
         AW,R10   R7                C+CCI
         AW,R10   NADDRESS          S+C+CCI
         CW,R10   LIMIT             LIMIT>S+C+CCI
         BG       UPDATE2           YES
         CW,R4    NE                DONE?
         BLE      *R15              NO
         AI,R5    1                 INC MI
         LW,R6    *AP,R5            GET NEXT POINTER
         CW,R5    ME                MI>=ME
         BG       %+3
         LW,R4    NO
         B        *R15
         AI,R15   1
UPDATE2  AI,R15   1
         B        *R15
*
*
************************************************************
*  READ CONTROL RECORD
************************************************************
*        R6 = NUMBER OF CHARACTERS - CR/LF RECEIVED
*        R7 = LINK ADDRESS
*
RD:SI    EQU          %
         PUSH     (R7,R10)          SAVE REGS
         CAL1,1   FPT:SI            READ COMMAND
         LW,R6    M:SI+4
         SLS,R6   -17
         AI,R6    -1
         BL       RD:SI2
RD:SI0   EQU      %
         LB,R7    IBUF,R6           GET LAST CHARACTER
         CI,R7    ' '               IS IT A BLANK
         BNE      RD:SI1            NO
         MTW,-1   R6
         BGE      RD:SI0
         B        RD:SI2            BLANK LINE: ADD LF
RD:SI1   EQU      %
         CI,R7    X'15'             TEST IF LAST CHAR IS CR
         BE       RD:SI3            YES
         CI,R7    X'0D'
         BE       RD:SI3            YES
RD:SI2   EQU      %
         AI,R6    1
         LI,R7    X'15'
         STB,R7   IBUF,R6           SET CARRIAGE RETURN IN LINE
RD:SI3   EQU      %
         MTW,0    J:JIT             CHECK FOR ON LINE MODE
         BLZ      RD:SI5            YES: CHECK FOR ASSIGNED INPUT
         LW,R7    R6                GET BYTE COUNT
         AI,R7    8                 AND ADD LEADING BLANKS
         CAL1,1   FPT:L1            NO-PRINT COMMAND AGAIN ON M:LO
         B        RD:SI8
*
RD:SI5   EQU      %
         CAL1,1   FPT:C2            COMPARE M:UC AND M:SI
         CI,R8    1
         BE       RD:SI8            SAME DEVICE
         LW,R7    R6
         AI,R7    1
         CAL1,1   FPT:L3            WRITE PROMPT
         CAL1,1   FPT:L2            PRINT COMMAND TO UC
RD:SI8   EQU      %
         PULL     (R7,R10)          RESTORE REGS.
         B        *R7               EXIT
*
*
************************************************************
*  WRITE MESSAGE
************************************************************
*        R6 = ADDRESS OF TEXTC STRING
*        R7 = LINK ADDRESS
*
TY:M     EQU      %
         PUSH     (R7,R10)
         LC       J:JIT             CHECK FOR BATCH MODE
         BCR,12   TY:M2             YES: PRINT ON M:LO
         LB,R7    *R6               GET BYTE COUNT
         CAL1,1    FPT:TY
         PULL     (R7,R10)
         B        *R7               EXIT
*
TY:M2    RES
         LB,R7    *R6
         CAL1,1   FPT:LO
         PULL     (R7,R10)
         B        *R7
*
         PAGE
********************************************************************
*                          C O N S T A N T S                       *
********************************************************************
*
*         POWERS OF EBCDIC-D=0
*
EBCDICS  DATA     X'1'
         DATA     X'100'
         DATA     X'10000'
         DATA     X'1000000'
*
*         POWERS OF DECIMAL-D=1
*
TENS     DATA     1
TEN      DATA     10
         DATA     100
         DATA     1000
         DATA     10000
         DATA     100000
         DATA     1000000
         DATA     10000000
         DATA     100000000
*
*         POWERS OF HEXIDECIMAL-D=2
*
SIXTEENS DATA     X'1'
         DATA     X'10'
         DATA     X'100'
         DATA     X'1000'
         DATA     X'10000'
BIT11    DATA     X'100000'
         DATA     X'1000000'
         DATA     X'10000000'
*
*         POWERS OF ADDRESS FORMAT-D=4
*
ADRS     DATA     1
         DATA     0
         DATA     X'4'
         DATA     X'40'
         DATA     X'400'
         DATA     X'4000'
         DATA     X'40000'
BIT9     DATA     X'400000'
*
*         TABLE OF MASKS
*
XF       DATA     X'F'
XFF      DATA     X'FF'
         DATA     X'FFF'
XFFFF    DATA     X'FFFF'
         DATA     X'FFFFF'
XFFFFFF  DATA     X'FFFFFF'
         DATA     X'FFFFFFF'
ONES     DATA     X'FFFFFFFF'
*
*
***************************************************************
*        MASKS AND VALUES
***************************************************************
*
*
*
BIT0     DATA     X'80000000'
BIT1     DATA     X'40000000'
         DATA     X'20000000'
BIT3     DATA     X'10000000'
         DATA     X'08000000'
BIT5     DATA     X'04000000'
         DATA     X'02000000'
BIT7     DATA     X'01000000'
BIT8     DATA     X'00800000'
BIT10    DATA     X'00200000'
BIT12    DATA     X'00080000'
BIT24    DATA     X'00000080'
BIT27    DATA     X'00000010'
         DATA     X'00000008'
         DATA     X'00000004'
BIT30    DATA     X'00000002'
         DATA     X'00000001'
*
X1FFFF   DATA     X'0001FFFF'
XF0      DATA     X'000000F0'
XFF00    DATA     X'0000FF00'
X8240000 DATA     X'08240000'
X8100000 DATA     X'08100000'
X7A0000  DATA     X'007A0000'
X700000  DATA     X'00700000'
X5F00000 DATA     X'05F00000'
X1100000 DATA     X'01100000'
X86      DATA     X'00000086'
XB7      DATA     X'000000B7'
XC0      DATA     X'000000C0'
X3       DATA     X'00000003'
X6       DATA     X'00000006'
X201FFFF DATA     X'0201FFFF'
XF00     DATA     X'00000F00'
XF0000   DATA     X'000F0000'
XF000000 DATA     X'0F000000'
YFFFF    DATA     X'FFFF0000'
YFE      DATA     X'FE000000'
Y6       DATA     X'60000000'
Y18      DATA     X'18000000'
*
RUNPRMPT DATA     X'15D96E15'
HLTPRMPT DATA     X'15C86E40'
Y1540404 DATA     X'15404040'
*
TIMENTRY GEN,16,16 X'804',ERRTAB+3
         GEN,16,16 X'484',ERRTAB+4
TIMEX    DATA     4800
*
IOTYPE   RES
         DATA     ' SIO'
         DATA     ' TIO'
         DATA     ' HIO'
         DATA     ' AIO'
         DATA     ' TDV'
         DATA     ' RIO'
         DATA     'POLR'
         DATA     'POLS'
#CR      DATA     '  CR'
#LP      DATA     '  LP'
#OC      DATA     '  OC'
#UC      DATA     '  UC'
         BOUND    8
RSTBRK   RES
         DATA     X'06200000'
         DATA     X'80000000'
         DATA     X'00000003'
*
*
***************************************************************
* DIRTAB - DIRECTIVE TABLE
***************************************************************
*
*         FIRST 8 BYTES=DIRECTIVE NAME IN EBCDIC(2 WORDS)
*         LAST WORD=DIRECTIVE DISCRIPTOR(DIR)
*
DIR      COM,1,2,2,3,24      AF(1),AF(2),AF(3),AF(4),AF(5)
*
*         AF(1)=BIT0=DESTINATION AND QUALIFIER 0 EXPECTED
*         AF(2)=BITS1-2=QUALIFIERS 1 AND 2 EXPECTED
*         AF(3)=BITS3-4=QUALIFIERS 3 AND 4 EXPECTED
*         AF(4)=BIT 6  =  NOT DEFINED
*               BIT 7  = Q3 AND Q4 NOT RELATED
*               BIT 5  = Q1 AND Q2 NOT RELATED
*         AF(5)=ADDRESS OF DIRECTIVES EXECUTION
*
DIRTAB   RES
         TEXTS    'DISPLAY '
         DIR      1,3,3,0,DISPLAY
*
         TEXTS    'END     '
         DIR      0,0,0,0,INIT4
*
         TEXTS    'HALT    '
         DIR      0,0,0,0,HALT
*
         TEXTS    'PRINT   '
         DIR      1,3,0,0,PRINT
*
         TEXTS    'REPLACE '
         DIR      1,3,3,0,REPLACE
*
         TEXTS    'RUN     '
         DIR      0,0,0,0,RUN
*
         TEXTS    'SELECT  '
         DIR      0,3,3,5,FTM
*
         TEXTS    'STORE   '
         DIR      1,3,3,0,STORE
*
         TEXTS    'UTM     '
         DIR      0,3,3,5,FTM
*
         DATA                       END OF TABLE
*
*
***************************************************************
* DESTINATION TABLE
***************************************************************
*
*         DESTINATION TABLE 5 WORDS PER ENTRY
*
*         FIRST 2 WORDS(8 BYTES)=DESTINATION NAME IN EBCDIC
*         THIRD WORD=ARRAY POINTER(DES1)
*
DES1     COM,8,7,17          AF(1),AF(2),AF(3)
*
*         AF(1)=NUMBER OF TABLES IN ARRAY.(M)
*         AF(2)=FORMAT:0=VETICAL, 1=HORIZONTAL
*         AF(3)=LOACATION OF FIRST TABLE POINTER.
*
*         FOURTH WORD=ELEMENT LIMIT (LESS 1)
*         FIFTH WORD=BYTE ADDRESS OF TABLE HEADING.
*
DESTAB   RES
         TEXTS    'ACCESS  '
         DES1     7,0,AC1P
         DATA     0
         DATA     BA(ACHDG)
*
*
         TEXTS    'MEMORY  '
MEMDES   DES1     1,1,M0P
         DATA     X'1FFFF'
         DATA
*
         TEXTS    'OPERATOR'
         DES1     8,0,OTP
         DATA
         DATA     BA(OTHDG)
*
         TEXTS    'POSITION'
         DES1     3,0,PAR1P
         DATA
         DATA     BA(PARHDG)
*
         TEXTS    'PATTERN '
         DES1     5,0,PAT1P
         DATA
         DATA     BA(PATHDG)
*
         TEXTS    'STATUS  '
         DES1     6,0,STATP
         DATA
         DATA     BA(STATHDG)
*
         DATA                       END OF TABLE
*
*
ELERRDES DES1     1,1,ELTPNR
*
*
***************************************************************
*         TABLE POINTERS
***************************************************************
*
TPNR     COM,8,1,3,3,17      AF(1),AF(2),AF(3),AF(4),AF(5)
*
*         AF(1)=NUMBER OF CHARS/FIELD.(C)
*         AF(2)=WRITE PROTECTED TABLE.
*         AF(3)=DATA FORMAT.(D):0=EBCDIC,1=DECIMAL,2=HEX,4=ADRS,5=T
*         AF(4)=TABLE TYPE(T):0=BYTE,1=HALFWORD,2=WORD,4=DBL WORD
*         AF(5)=ADDRESS OF FIRST TABLE ELEMENT.(AT)
*
*
*        NOTE:   THE FIRST TPNR OF EACH TABLE IS FOR THE INDEX
*              COUNT WHICH CAN BE GENERATED AUTOMATICALLY.  IF
*              NO INDEX IS REQUIRED, THE FIRST TPNR MUST BE 0.
*
AC1P     DATA                       ACCESS TABLE POINTERS
         TPNR     4,1,2,2,UA        DADR- UNIT ADDRESS
         TPNR     4,1,2,2,DMOD      DMOD - DEVICE MODEL NUMBER
         TPNR     4,1,2,2,CMOD      CONTROLLER MODEL NUMBER
         TPNR     4,1,2,2,TMFIRST   TMLO- TM LO LIMIT
         TPNR     4,1,2,2,TMLAST    TMHI- TM HI LIMIT
         TPNR     4,1,2,2,TMITO     TITO- INIT. ITER.
         TPNR     4,1,2,2,FDPITO    PITO- FDP INIT. ITER.
*
M0P      TPNR     6,1,2,2,0
         TPNR     8,0,2,2,0
*
OTP      DATA                       HEADING
         TPNR     1,0,2,2,#PC       P  -       PRINT CONTROL VALUE
         TPNR     1,0,2,2,#RC       R  -       RUN CONTROL VALUE
         TPNR     3,0,2,2,ERRCNT    ELC- LIMITS ERR LINE OUTPUTS
         TPNR     2,0,0,2,LO        LO - LOG DEVICE MNEMONIC
         TPNR     4,0,2,2,LOCK
         TPNR     3,0,2,2,PRI
         TPNR     3,0,2,2,ELS
         TPNR     4,0,2,2,#RETRY    RETRY - RETRY NUMBER
*
PAR1P    DATA
         TPNR     8,0,2,2,#POS
         TPNR     8,0,2,2,#POS1
         TPNR     8,0,2,2,#POS2
*
PAT1P    DATA
         TPNR     1,0,2,2,#PTYP
         TPNR     8,0,2,2,#PBUF
         TPNR     8,0,2,2,#PBUF+1
         TPNR     8,0,2,2,#PBUF+2
         TPNR     8,0,2,2,#PBUF+3
*
STATP    DATA
         TPNR     4,1,2,2,TMI       TM - CURRENT TEST MODULE
         TPNR     4,1,2,2,TMIT      LOOP - TM ITERATION
         TPNR     4,1,2,2,TMERR     TMER - TM ERROR COUNT
         TPNR     4,1,2,2,TMEXEC    TMEX - TM'S RUN THIS MODE
         TPNR     4,1,2,2,FDPIT     PASS - FDP ITERATION
         TPNR     8,1,2,2,FDPERR    FDPERRS -  TOTAL ERRORS
*
TPNR0    TPNR     2,0,0,1,PRE0
         TPNR     2,0,0,1,PRE1
         TPNR     2,0,0,1,PRE2
         TPNR     2,0,0,1,PRE3
*
ELTPNR   DATA
         TPNR     2,0,0,1,PRE0
         TPNR     4,0,2,2,ERRTAB    SEQUENCE
         TPNR     1,0,2,2,ERRTAB+1  SEVERITY
         TPNR     4,0,2,2,ERRTAB+2  IDENTIFIER
         TPNR     8,0,0,2,ERRTAB+3  TIME
         TPNR     8,0,2,2,ERRTAB+4
         TPNR     8,0,2,2,ERRTAB+5
         TPNR     8,0,2,2,ERRTAB+6
         TPNR     8,0,2,2,ERRTAB+7
*
*
*
***************************************************************
***************************************************************
*
CODER    COM,8,8,8,8,8,8,8,8        AF(1),AF(2),AF(3),AF(4);
                                   ,AF(5),AF(6),AF(7),AF(8)
*
         BOUND    8
*
*
JCODES   CODER    10,9,13,14,32          N PRIME LOG CODES
KCODES1  CODER    21,22,24,25,26,15     ERROR HEADING  (WITH TM)
PRE0     DATA     '    '
PRE1     DATA     'EX  '
         DATA     'OB  '
PRE2     DATA     'IN  '
PRE3     DATA     'ME  '
         DATA     'MO  '
         DATA     'OB  '
*
*
***************************************************************
* ELHDGS - ERROR LOGGING HEADINGS
***************************************************************
*
         BOUND    8
ELHDGS   RES                      CODE
         TEXTS    '        '        0
         TEXTS    'CNT     '        1
         TEXTS    ' EFFADD '        2
         TEXTS    '  INST  '        3
         TEXTS    ' MEMORY '        4
         TEXTS    'MEMORY+1'        5
         TEXTS    'LOCATION'        6
         TEXTS    '  PSW1  '        7
         TEXTS    '  PSW2  '        8
         TEXTS    'S       '        9
         TEXTS    'SEQ#    '        10
         TEXTS    'STATUS 0'        11
         TEXTS    'STATUS 1'        12
         TEXTS    ' ID     '        13
         TEXTS    '  TIME  '        14
         TEXTS    'UNAD    '        15
         TEXTS    '  PSW3  '        16
         TEXTS    '  PSW4  '        17
         TEXTS    'NAME   '         18
         TEXTS    'CH      '        19
         TEXTS    'LOC     '        20
         TEXTS    'PROG    '        21
         TEXTS    ' TM     '        22
         TEXTS    ' UM     '        23
         TEXTS    'MODE    '        24
         TEXTS    ' ERRORS '        25
         TEXTS    'MOD#    '        26
         TEXTS    'FLAWED  '        27
         TEXTS    'ALTERNAT'        28
         TEXTS    '        '        29
         TEXTS    '        '        30
         TEXTS    '        '        31
          TEXTS   '        '        32
          TEXTS   ' IOCOMM '        33
          TEXTS   'IOCOMM+1'        34
          TEXTS   ' ERRORS '        35
          TEXTS   'EXPECTED'        36
          TEXTS   'MILISECS'        37
          TEXTS   'OBSERVED'        38
          TEXTS   '  SEEK  '        39
          TEXTS   ' SENSE  '        40
          TEXTS   '  COMADR'        41
          TEXTS   'SIO - CC'        42
          TEXTS   'TIO - CC'        43
          TEXTS   'HIO - CC'        44
          TEXTS   'TYPE    '        45
          TEXTS   'IO      '        46
          TEXTS   'TMS     '        47
          TEXTS   'LEN     '        48
          TEXTS   'INCREMNT'        49
          TEXTS   '  SEED  '        50
          TEXTS   'TDV - CC'        51
          TEXTS   'AIO - CC'        52
          TEXTS   ' BC     '        53
          TEXTS   'ADR     '        54
          TEXTS   'EMAP    '        55
         TEXTS    '        '        56
         TEXTS    'POLR  CC'        57
         TEXTS    'POLP  CC'        58
         TEXTS    'RIO   CC'        59
         TEXTS    'SEEK ADR'        60
         TEXTS    'ALT. ADR'        61
         TEXTS    'MASK.EXP'        62
         TEXTS    'MASK.OBS'        63
         TEXTS    '        '        64
         TEXTS    'HEAD    '        65
         TEXTS    'DATA CHK'        66
         TEXTS    'FLAWED  '        67
         TEXTS    'HDR. CHK'        68
         TEXTS    'VERIF.E.'        69
         TEXTS    'TOTAL E.'        70
ELHDGSIZ EQU      DA(%)-DA(ELHDGS)
*
*
***************************************************************
* ELTPNRS - ERROR LOGGING TABLE POINTERS
***************************************************************
*
*        THE FOLLOWING TPNR'S PROVIDE CONTROL INFORMATION FOR THE
*          HEADING OF THE CORRESPONDING INDEX.
*
*        BIT SIGNIFICANCE IS AS FOLLOWS:
*                 0-3               NOT USED
*                 4-7               NUMBER OF CHARACTERS IN FIELD
*                                   (HEADING SIZE CANNOT EXCEED IT)
*                 8-11              DECODE TYPE
*                                        0 = EBCDIC
*                                        1 = DECIMAL
*                                        2 = HEX
*                                        4 = ADDRESS (TO 128K)
*                                        5 = TIME (HR:MIN:SEC)
*                 12-15             TABLE TYPE
*                                        4 = WORD TABLE
*
*
ELTPNRS  RES                      CODE
         DATA,2   X'824'            0  BLANKS
         DATA,2   X'424'            1  'CNT     '
         DATA,2   X'844'            2  ' EFFADD '
         DATA,2   X'824'            3  '  INST  '
         DATA,2   X'824'            4  ' MEMORY '
         DATA,2   X'824'            5  'MEMORY+1'
         DATA,2   X'824'            6  'LOCATION'
         DATA,2   X'824'            7  '  PSW1  '
         DATA,2   X'824'            8  '  PSW2  '
         DATA,2   X'124'            9  'S       '
         DATA,2   X'424'            10 'SEQ#    '
         DATA,2   X'824'            11 'STATUS 0'
         DATA,2   X'824'            12 'STATUS 1'
         DATA,2   X'424'            13 ' ID     '
         DATA,2   X'804'            14 '  TIME  '
         DATA,2   X'424'            15 'UNAD    '
         DATA,2   X'824'            16 '  PSW3  '
         DATA,2   X'824'            17 '  PSW4  '
         DATA,2   X'404'            18 'NAME    '
         DATA,2   X'222'            19 'CH      '
         DATA,2   X'322'            20 'LOC     '
         DATA,2   X'404'            21 'PROG    '
         DATA,2   X'424'            22 ' TM     '
         DATA,2   X'424'            23 ' UM     '
         DATA,2   X'424'            24 'MODE    '
         DATA,2   X'824'            25 ' ERRORS '
         DATA,2   X'424'            26 'MOD#    '
         DATA,2   X'824'            27
         DATA,2   X'824'            28
         DATA,2   X'824'            29
         DATA,2   X'824'            30
         DATA,2   X'824'            31
          DATA,2  X'404'            32
          DATA,2  X'824'            33
          DATA,2  X'824'            34
          DATA,2  X'824'            35
          DATA,2  X'824'            36
          DATA,2  X'814'            37
          DATA,2  X'824'            38
          DATA,2  X'824'            39
          DATA,2  X'824'            40
          DATA,2  X'824'            41
          DATA,2  X'824'            42
          DATA,2  X'824'            43
          DATA,2  X'824'            44
          DATA,2  X'424'            45
          DATA,2  X'224'            46
          DATA,2  X'424'            47
          DATA,2  X'424'            48
          DATA,2  X'824'            49
          DATA,2  X'824'            50
          DATA,2  X'824'            51
          DATA,2  X'824'            52
          DATA,2  X'424'            53
          DATA,2  X'424'            54
          DATA,2  X'424'            55
         DATA,2   X'824'            56
         DATA,2   X'824'            57
         DATA,2   X'824'            58
         DATA,2   X'824'            59
         DATA,2   X'824'            60
         DATA,2   X'824'            61
         DATA,2   X'824'            62
         DATA,2   X'824'            63
         DATA,2   X'814'            64
         DATA,2   X'414'            65
         DATA,2   X'814'            66
         DATA,2   X'814'            67
         DATA,2   X'814'            68
         DATA,2   X'814'            69
         DATA,2   X'814'            70
         PAGE
********************************************************************
*                          T E M P O R A R Y   S T O R A G E       *
********************************************************************
*
*
#REPORT  PZE      REPORT            PR'S MESSAGE OUTPUT ROUTINE
#MTYPE   PZE      0                 MACHINE TYPE (#MTYPE)
*
*
PN       DATA     'VOLI'            PROG      PROGRAM NAME
CMOD     DATA     0                 MOD#      MODEL NUMBER
UA       DATA     0                 UNAD      UNIT ADDRESS
TMFIRST  DATA     1                 TMLO      TM RANGE, LOWER LIMIT
TMLAST   DATA     1                 TMHI      TM RANGE, UPPER LIMIT
TMITO    DATA     1                 TMIT      TM ITERATION COUNT
FDPITO   DATA     1                 FDIT      FDP ITERATION COUNT
*
ERRCNT   PZE      48                ELC       MAX ERR MSG PART LNGTH
LIMIT    PZE      72                CH        SET TO PLATEN WIDTH
LO       PZE      0                 LO        LOG DEVICE MNEMONIC
SI       PZE      0                 SI        INPUT (CONTROL) ''
*
LOCK     PZE      0                 LOCK      SET=SOFT LOCK IN CORE
PRI      PZE      X'FF'             PRI       QUEUE PRIORITY F0=HI
ELS      PZE      0                 ELS       SET FOR ELLA LOGGING
*
TMI      PZE      0                 TM        CURRENT TM INDEX
TMIT     PZE      0                 LOOP      CURRENT TM ITERATION
TMERR    PZE      0                 TMER      CURRENT TM ERROR CNT
TMEXEC   PZE      0                 TMEX      TM'S RUN THIS MODE
TMABORT  PZE      0                 WPTM      TM'S WRITE ABORTED
FDPIT    PZE      0                 PASS      CURRENT FDP ITERATION
FDPERR   PZE      0                 FDPERRS   CURRENT FDP ERR TOTAL
*
SCANBUF  PZD
         PZE
         PZD
Q0       PZE
Q1       PZD
Q2       PZE
Q3       PZD
         PZE
         PZD
DID:1    PZE
DED:2    PZD
DED:3    PZE
OCI      PZD
CCI      PZE
BCI      PZE
NADDRESS PZE
ADDRESS  PZE
APTO     PZE
NO       PZE
NE       PZE
MO       PZE
ME       PZE
CNTRO    PZE
AP       PZE
OUTDEV   PZE
DCBNAME  PZE
LPBUF    PZE
LPFLG    PZE
INBUF    PZE
MSGWK0   PZE
MSGMOD   PZE
SUPRESS  PZE
TIME     PZE
TIME1    PZE
CCPSTK   PZE
RETURN1  PZE
RETURN2  PZE
RETURN3  PZE
RETURN4  PZE
RETURN5  PZE
RETURN6  PZE
MI       PZE
WK0      PZE
LOGFLG   PZE
SEQUENCE PZD
         PZE
ERRCNTI  PZE
EFSTK    PZE
ELSTK    PZE
CDLIST   PZE
OLDLO    PZE
OLDUA    PZE
OLDF%TYP PZE
OLDLOCK  PZE
OLDELS   PZE
LASTBYTE PZE
WAITFLG  PZE
4SURE    PZE
REPSAVE  PZE
MBUF     PZE
DELAY    PZE
CNTRLRAB PZE
UABORT   PZE
OFFLTM   PZE
ERREG    PZE
ERRBUF   PZE
OPDEX    PZE
DMOD     DATA     0                 DEVICE MODEL NUMBER
F%TYP    DATA     0
DEVTYP   DATA     0                 DEVICE TYPE MNEMONIC
DCT:X    DATA     0
NGC      DATA     0
NSC      DATA     0                 NUMBER OF SECTORS/CYLINDER.
*
#PC      DATA     1                 PRINT CONTROL VALUE
#RC      DATA     1                 RUN CONTROL VALUE
INHIBIT  DATA     0
*
CVMLIST  RES
%DCT1    DATA     DCT1              THIS LIST HAS TO BE ORDERED WITH
%DCT16   DATA     DCT16              ASCENDING REAL MEMORY ADDRESSES
%DCT22   DATA     DCT22                SO THAT WE CAN MAP IT INTO
%DISCLIMS DATA    DISCLIMS              CONTIGUANT VIRTUAL MEMORY
%AVRTBL  DATA     AVRTBL
%HGP     DATA     HGP
         DATA     HGP+512
*
CVMSZ    EQU      %-CVMLIST
*
*
*
         BOUND    8
NEWSTACK DATA     STACK
         DATA,2   STACKSZ,0
*
         BOUND    8
STACKDW  DATA     STACK             GLOBAL: DW FOR HARDWARE PSW/PLW
         DATA,2   STACKSZ,0
DEV:YYNDD RES     2
PDEV:YYNDD RES    2
*
STACK    RES      STACKSZ           GLOBAL: STACK USED FOR PUSH/PULL
*
CMDADR   RES      1                 COMMAND ROUTINE ADDRESS
CMDRTN   RES      1                 COMMAND LEVEL RETURN
         BOUND    8
DIAGFLG  RES      1                 DIAG FLAG
EXFLG    RES      1                 EXECUTION FLAG CONTROLS RUNNING MSG
         PAGE
********************************************************************
*                            T E X T   M E S S A G E S             *
********************************************************************
*
*        LOG MESSAGES
*
ENDMSG   TEXTS    CR,'XXXX I/O ERRORS',CR,EM
TMMSG    TEXTS    ' XXXX ROUTINES EXECUTED',CR,EM
PASSMSG  TEXTS    ' PASS XXXX ',CR,EM
DONEMSG    TEXTS  'COMPLETE',CR,CR,EM
*
*        ERROR TITLE MESSAGES
*
TITLE1   TEXTS    CR,'DISK PACK I/O ERROR',CR,EM
*
*         SYNTAX ERROR MESSAGES
*
Q1ERROR  TEXTS    '***INVALID PARAMETER',CR,EM
Q2ERROR  TEXTS    '***INVALID CHARACTER',CR,EM
Q3ERROR  TEXTS    '***INVALID REQUEST',CR,EM
Q4ERROR  TEXTS    '***TABLE PROTECTED',CR,EM
SELERR   TEXTS    '***SELECTION ERROR',CR,EM
TICKS    TEXTS    '''''''''''''''''',EM
*
*
***************************************************************
*         HEADING MESSAGES
***************************************************************
*
ACHDG    TEXTS    CR,;
 'ACCESS TABEL',CR,;
 'DADR DMOD CMOD FROS LROS RITN SITN',EM
*
OTHDG    TEXTS    CR,;
 'OPERATOR TABEL',CR,;
 'P R ELC LO LOCK PRI SEL RETRY',EM
*
PARHDG   TEXTS    CR,;
 'POSITION TABEL',CR,;
 'SEEKADR1 SEEKADR2 SECTORINC',EM
*
PATHDG   TEXTS    CR,;
 'PATTERN TABEL',CR,;
 'T PATTERN1 PATTERN2 PATTERN3 PATTERN4',EM
*
STATHDG  TEXTS    CR,;
 'STATUS TABEL',CR,;
 'ROUT RCNT RERR REXE SEXE ERRORCNT ',EM
*
*
***************************************************************
*        CONTROL MESSAGES
***************************************************************
*
NOPRIV   TEXTCS   'INSUFFICIENT PRIVILEGE',CR
HERE     TEXTCS   'VOLINIT E01 HERE',CR
KEYIN  TEXTC 'MOUNT PACK  SN #### ON YYNDD AND KEYIN:  DIAG  ID  ',CR
PAUSE    TEXTCS   'VOLINIT WAITS FOR OPERATOR KEYIN',CR
RUNMSG   TEXTS    'TYPE RUN TO START',CR,EM
MSG:BM   TEXTCS    'WARNING: VTOC TOO BIG FOR CURRENT SYSTEM',CR
MSG:PE   TEXTCS   'DEVICE CANNOT BE PARTITIONED',CR
MSG:AB   TEXTCS   'VOLINIT ABORTED',CR
MSG:MP   TEXTCS   'CANNOT ACCESS MONITOR LOCATIONS',CR
*
*        ERROR AND ABNORMAL MESSAGES
*
BADUA    TEXTCS   ' UA XXX NOT IN THIS SYST',CR
WARNING  TEXTCS   ' CPV TYPE CODE=XX ON TMXX',CR
ERRABN   TEXTCS   ' ERR OR ABN:   XXXX AT XXXX',CR
TERM     TEXTCS   'CANNOT GET OPERATOR RESPONSE',CR
OPMES    RES      18
OVER     TEXTCS   'MSG > 71 CHARS',CR
MSG:DP   TEXTCS   '  YYNDD PARTITIONED BY VOLINIT',CR
MSG:DR   TEXTCS   '  YYNDD RETURNED BY VOLINIT',CR
MSG:RUN  TEXTCS   'RUNNING',CR
*
MSG:E2   TEXTCS   'DEVICE NOT PRESENT',CR
MSG:E3   TEXTCS   'DEVICE NOT A DISK PACK',CR
MSG:E4   TEXTCS   'DEVICE NOT A PRIVATE PACK',CR
MSG:E5   TEXTCS   'DEVICE BUSY',CR
MSG:E6   TEXTCS   'VTOC IS TOO BIG',CR
MSG:E7   TEXTCS   'NO SUCH DEVICE AVAILABLE',CR
MSG:E8   TEXTCS   'DUPLICATE ACCT IGNORED',CR
*
*
P:SN     TEXTCS   'SN   =        ',CR
P:ACCT   TEXTCS   'ACCT = ACCOUNTX FD FDAX',CR
P:NGC    TEXTCS   'NGC  =         ',CR
*
         PAGE
********************************************************************
*                            B U F F E R S                         *
********************************************************************
         BOUND    8
#IBUF    DATA     '    ','    '
IBUF     RES      36
ELHDG    RES      22
OUTBUF   RES      22
ERRTAB   RES      8
STATUS   RES      16
ETHREGS  RES      2
AUDREGS  RES      17
FDPREGS  RES      16
REGS     RES      16
SAVREGS1 RES      16
SAVREGS0 RES      16
CALREGS  RES      16
LBUFER   RES      48
ERRFILE  RES      310               ERR FILE BUFFER
PATCH    DSECT    0
         RES      40
*
***************************************************************
***************************************************************
*
F:DIAG   DSECT    1
F:DIAG   M:DDCB   (DEVICE,'LP'),(ABN,HELP0),(CLIST,22)
*
*        GRANULE 0 : VOLUME TABLE OF CONTENTS (VTOC)
*
         PSECT    0
*
         DEF      VTOC
VTOC     TEXT     ':LBL','P000','    '
         DATA     7,13,X'7FFFFFFC',X'70000'
         DATA     X'7FFFFFFF'
         LIST     0
         DO1      504
         DATA     -1
         LIST     1
*
*        GRANULE 1 : ACCOUNT DIRECTORY
*
ACND     DATA     0,0,X'0021400C'   AD HEADING INFORMATION.
         DATA     X'0B404040',':SYS','    ',X'10004',X'600',0
         RES      512-96*2-(%-ACND)
ACNTBL   RES      96*2              ACCOUNT DOUBLEWORD TABLE (LATER
*                                     USED AS PART OF AD).
NAV      EQU      2                 OFFSET TO NAV HALFWORD.
*
*
*        GRANULE 2 AND BEGINNING EACH CYLINDER THEREAFTER:
*                 FILE DIRECTORY
*
FILD     DATA     0,0,X'000C4020'   MI HEADER INFO - 3 WORDS.
         LIST     0                 ZERO OUT NEXT 512-3-4 WORDS
         DO1      512-3-4
         DATA     0
         LIST     1
         DATA     X'80000000',X'1B010006',0,0 E,(N)GAVAL,LINKS - 4 WDS.
NGAVAL   EQU      509               WORD OFFSET TO NGAVAL BYTE.
HX%GAVAL EQU      509*2+1           HALFWORD OFFSET TO GAVAL HW.
         STW,R2   FILD+HX%GAVAL**-1   GAVAL.
*
*
**
**   DATA AND TEMPORARY STORAGE USED DURING ACCOUNT NUMBER
**   INPUT, ACCOUNT NUMBER TABLE SORT, AND ACCOUNT DIRECTORY
**   SETUP.
**
#UNSORTED RES     1
LAST%SWAP%IX RES  1
*
*
         BOUND    8
#ACCOUNTS DATA    1                 NUMBER OF ACCOUNTS IN AD.
ADENTSKEL DATA    X'0B404040',0,0,X'10000',X'400',0 STARTS ODD.
ACN      EQU      1                 OFFSET TO ACCOUNT DOUBLEWORD.
DABLK    EQU      3                 OFFSET TO FD FDA.
EOF      EQU      4                 OFFSET TO EOF BIT.
*
         BOUND    8
ADACNPTR DATA     BA(ADENTSKEL),X'1500000C'+BA(ACND)
ADACNRST DATA     -21,X'15000000'   USED TO RESET ABOVE POINTER.
*
         BOUND    8
1STACNTBLPTR DATA BA(ACNTBL),X'08000008'+BA(ACNTBL)
*
         BOUND    8
ACNTBLPTR RES     2
*
*
         PAGE
***************************************************************
***************************************************************
***                                                         ***
***                                                         ***
*** PROGRAM VARIABLES AND CONTANTS                          ***
***                                                         ***
***                                                         ***
***************************************************************
***************************************************************
*
*
*
*
*
*
*        *** GLOBAL PARAMETERS ***
*
*
#TRACE   DATA     0                 TRACE FLAG
#UNM     DATA     0                 UNIT NAME MAP
#DEVADR  DATA     0                 DEVICE ADDRESS
#DELAY   DATA     0                 TIME DELAY IN SECONDS
#ODELAY  DATA     0                 OBSERVED DELAY IN MILLISECONDS
#TIMEOUT DATA     0                 TIMEOUT FLAG
#SEED    DATA     0                 RANDOM NUMBER
#PCNT    DATA     0                 PASS COUNT
#DBMF    DATA     0                 DATA BASE MODIFIER FLAG
#TMF     DATA     0                 TESTMODE FLAG
#HBUFLEN DATA     0                 HEADER BUFFER LENGTH
*
#BUFLEN  DATA     1024              BUFFER LENGTH IN BYTES
#PTYP    DATA     3                 PATTERN TYP
#CCMASK  DATA     0                 CONDITION CODE MASK
#COMERR  DATA     0                 COMPARE ERROR COUNT
#COMLIM  DATA     0                 PRINT LIMIT FOR COMPARE ROUTINE
#TMERROR DATA     0                 TMSEQ ERROR COUNT
*
@BUF     DATA     BF1               ADDRESS OF BUFFER LABEL FOR PAT SUBR.
@BUF1    DATA     BF1               ADDRESS OF BUFFER 1 LABEL FOR COM/COMP
@BUF2    DATA     BF2               ADDRESS OF BUFFER 2 LABEL FOR COM/COMP
@PBUF    DATA     0                 ADDRESS OF PATTERN BUFFER LABEL (PAT)
*
#PBUF    RES
         DATA     X'DB6DB6DB',X'6DB6DB6D',X'B6DB6DB6'
         DATA     0
#POS     DATA     0                 POSITION WORDS            1-3
#POS1    DATA     0
#POS2    DATA     0
#RETRY   DATA     3                 RETRY WORD
#ALTSK   DATA     0                 ALTERNATE SEEK AREA ADDRESS
*
*
*
*        *** COMMON ERROR MESSAGE LOCATIONS ***
*
:D       EQU      %                 DATA LIST
:D0      RES      1
:D1      RES      1
:D2      RES      1
:D3      RES      1
:D4      RES      1
:D5      RES      1
:D6      RES      1
         RES      20
*
*
*
*        *** CONSTANTS ***
*
K0       DATA     0
K1       DATA     1
K3       DATA     3
K8       DATA     8
*
KM1      DATA     -1
*
KX00FF   DATA     X'00FF'
*
*
*        *** SPECIAL GLOBAL PARAMETERS ***
*
*
#SKADR   DATA     0
#SFIRST  DATA     0                 FIRST SECTOR ( IN SECTORS)
#SCNT    DATA     0                 SECTOR COUNT (IN SECTORS)
#SLAST   DATA     0                 LAST SECTOR (IN SECTORS)
#SMAX    DATA     0                 MAXIMUM OF SECTORS (IN SECTORS)
#FLAWM   DATA     0                 FLAW MARK FLAG
#ALTM    DATA     0                 ALTERNATE ADDRESS FLAG
#RCNT    DATA     0                 RETRY COUNT
#INH:P   DATA     0                 INHIBIT PRINTOUT
@HBUF1   DATA     BF1
@HBUF2   DATA     BF2
*                                   CURRENT MAXIMAL NUMBER OF
CMAX     RES      1                   CYLINDERS/DISK
TMAX     RES      1                   TRACKS/CYLINDER
SMAX     RES      1                   SECTORS/TRACK
*
STMAX    RES      1                 SECTORS/CYLINDER
*
CLAST    RES      1                   CYLINDERS OF A DISK
TLAST    RES      1                   TRACKS OF A CYLINDER
SLAST    RES      1                   SECTORS OF A TRACK
*
HMASK    RES      2                 MASK FOR HEADER
ASKADR   RES      1                 ALTERNATE SEEK ADDRESS
ACYL     RES      1                 ALTERNATE CYLINDER START
LTRACK   RES      1                 LAST TRACK
RETRY    RES      1                 RETRY VALUE
HBUFLEN  RES      1                 HEADER BUFFER LENGTH
#DEVX    DATA     0                 DEVICE TYPE INDEX
#CONTX   DATA     0                 CONTROLLER TYPE INDEX
*
*
***************************************************************
* DEVICE TYPE DEPENDANT TABLES
***************************************************************
*
*                 0    1    2    3    4    5
*                 7240/7270/7260/7275/3275/3283
*
*
CNUM     DATA     0203,0406,0203,0411,0411,0823
TNUM     DATA     0020,0020,0020,0019,0019,0019
SNUM     DATA     0006,0006,0011,0011,0012,0012
DTYP     DATA     0000,0000,0001,0001,0002,0002
ACNUM    DATA     0200,0400,0200,0404,0404,0808
*
*
* CONTROLLER TYPE INDEXES
*
RDC      EQU      0                 ROTATING DISK CONTROLLER 7240/7270
RMC      EQU      1                 ROTATING MEMORY CONTR.   7260/7275
RMP      EQU      2                 ROTATING MEMORY PROC. 3275/3283
*
*
* DEVICE TYPE INDEXES
*
#7240    EQU      0
#7270    EQU      1
#7260    EQU      2
#7275    EQU      3
#3275    EQU      4
#3283    EQU      5
*
*
*
* UN LIST - UNIT NAME LIST
* ------------------------
*
* THIS FDP CAN RECOGNIZE THE FOLLOWING UNIT MODEL NUMBERS.
* THE GENERAL FORMAT OF EACH ITEM IN THE LIST IS
* LF     DATA     'NNNN',X'HHHHHHHH'
*        WHERE    'NNNN'     = UNIT NAME (LEADING BLANKS)
*                 X'HHHHHHHH'= MAP BIT
*                 (ONE UNIQUE BIT IS SET FOR EACH UNIT NAME)
*
         BOUND    8
#UNLIST  EQU      %                      MODEL       DEVTYPM
         DATA     X'7240',X'00000000'
         DATA     X'7270',X'01000000'
         DATA     X'7260',X'02000000'
         DATA     X'7275',X'03000000'
         DATA     X'3275',X'04000000'
         DATA     X'3283',X'05000000'
#UNLISTE EQU      %                 END OF LIST
#UNLISTS EQU      (#UNLIST-#UNLISTE)  LIST SIZE (NEG.)
*
         PAGE
***************************************************************
***************************************************************
***                                                         ***
***                                                         ***
*** TEST ROUTINES AND SUBROUTINES                           ***
***                                                         ***
***                                                         ***
***************************************************************
***************************************************************
*
*
**************************************************************
*** TEST SUBROUTINE SEQUENCER (#SEQ ) ROUTINE AND DATA      ***
**************************************************************
*
*
*
#SEQTCNT DATA     0                 TEST SUBROUTINE COUNT
#SEQEX   DATA     0                 SEQUENCER EXECUTION FLAG
#SEQAF   DATA     0                 SEQUENCER ABORT FLAG
#SEQCEF  DATA     0                 SEQUENCER CURRENT SUBROUTINE ERROR FLAG
#SEQPA   DATA     0                 SEQUENCER PARAMETER ADDRESS
#SEQINH  DATA     0                 SEQUENCER PRINT INHIBIT FLAG
#SEQTERM DATA     0                 SEQUENCER TERMINATION FLAG
#SEQCNT  DATA     0                 SEQUENCER EXECUTION COUNT
*
#SEQPERF DATA     0                 CURRENT PERFORMANCE BIT
#SEQTE   DATA     0                 ADDR OF FIRST ELEMENT OF NEXT
         BOUND    8
#SEQSAVE RES      16                TEMPORARY STORAGE OF REGISTER
#SEQEF   DATA     0                 ERROR FLAG
#SEQTAB  RES      16                TEST SUBROUTINE ADR TABLE
#SEQTABA DATA     0                 ADR OF CURRENT ELEMENT OF
#SEQTABB DATA     0                 ADR OF CURRENT ELEMENT O
*                                     THE TEST SUBR ADR TAB
*
*
#SEQET2  ETAB     3,:D,3,:H22
*
#SEQET3  GEN,08,24 1,#SEQP3         LAST CALL
         GEN,08,24 X'40',0             TO ERROR ROUTINE
         GEN,08,24 0,:H23
*
#SEQET4  ETAB     2,#SEQP1,2,:H24
#SEQET5  ETAB     2,#SEQP2,2,:H24
#SEQET6  GEN,8,24 1,#SEQP3          FIRST CALL
         GEN,8,24 X'10',0                TO ERROR ROUTINE
         GEN,8,24 0,:H23
*
#SEQP1   TEXT     'ERR '
         DATA     0
#SEQP2   TEXT     'DISP'
         DATA     0
#SEQP3   TEXT     '    '
*
* SEQUENCER ENTRY - THE LOCATION POINTED TO BY THE LINK ADDRESS
*                   MUST CONTAIN THE ADDRESS OF THE AUXILIAR
*                   TEST MODUL. THE FIRST LOCATION OF THIS TEST
*                   MODUL MUST CONTAIN THE UPPER LIMIT OF THE
*                   TEST MODUL.
*
#SEQX    EQU      %
         STW,7    #SEQSAVE+7        SAVE LINK ADDRESS
         LW,7     *#SEQSAVE+7       GET TM ADDRESS
         STW,7    #SEQPA
         MTW,1    #SEQSAVE+7        INC. LINK ADDRESS
         LW,7     *#SEQPA           GET UPPER LIMIT OF TM
         STW,7    #SEQTE             AND SAVE IT.
         MTW,1    #SEQPA            INC. TM POINTER
*
#SEQ11   EQU      %                 SAVE ALL REGISTERS
         STD,R0   #SEQSAVE+0
         STD,R2   #SEQSAVE+2
         STD,R4   #SEQSAVE+4
         STW,6    #SEQSAVE+6
         STD,R8   #SEQSAVE+8
         STD,R10  #SEQSAVE+10
         STD,R12  #SEQSAVE+12
         STD,R14  #SEQSAVE+14
         STW,R1   #SEQPERF          SET INITIAL PERFORMANCE BIT
         STW,R0   #SEQEF            RESET ERROR FLAG
         STW,R0   #SEQAF            RESET ABORT FLAG
         STW,R1   #SEQEX            SET EXECUTION PASS INDICATOR
         MTW,1    #SEQCNT
         LI,R7    #SEQTAB           SET STARTING ADR
         STW,R7   #SEQTABA            OF TEST SUBR. ADR TABLE
#SEQ12   EQU      %
         STW,R0   #SEQCEF           RESET CURRENT ERROR FLAG
         LW,7     #SEQPA            GET CURRENT ELEMENT ADR
         CW,7     #SEQTE            TEST FOR END OF CURRENT TM
         BGE      #SEQ16            DONE
         LW,7     *#SEQPA           SET TEST SUBROUTINE ADDRESS
         STW,R7   *#SEQTABA         SAVE TEST SUBR ADR (REPORT
*                                     ENTRY)
         MTW,1    R7                INCR ADR TO EXECUTION ENTRY
         MTW,1    #SEQTABA          INCR TEST SUBR. TABLE ADR
         MTW,1    #SEQPA            INCR CURRENT ELEMENT ADR
         B        *R7
#SEQER   MTW,1    #SEQCEF           SET CURRENT ERROR FLAG
#SEQOK   EQU      %
         MTW,0    #SEQCEF           TEST CURRENT ERROR FLAG
         BEZ      #SEQ14            B: ERROR
         LW,R7    #SEQPERF          GET CURRENT PERFORMANCE BIT
         AW,R7    #SEQEF            SET THE ERROR FLAG
         STW,R7   #SEQEF              AND SAVE IT
#SEQ14   EQU      %
         LW,R7    #SEQPERF          GET CURRENT PERFORMANCE BIT
         AW,R7    R7                SHIFT LEFT BY 1
         STW,R7   #SEQPERF          SAVE UPDATED PERFORMANCE BIT
         MTW,0    #SEQAF            TEST THE ABORT FLAG
         BEZ      #SEQ12            TRY NEXT TEST SUBROUTINE
#SEQ16   EQU      %
         B        #SEQ21
*
#SEQR    EQU      %
         STW,7    #SEQSAVE+7
#SEQ21   EQU      %
         STW,0    #SEQEX            SET REPORT PASS INDICATOR
         STW,0    #SEQTCNT          RESET TEST SUBROUTINE COUNT
         LI,R7    #SEQTAB           SET STARTING ADR
         STW,R7   #SEQTABB            TEST SUBR ADR TABLE
         STW,R1   #SEQPERF          SET INITIAL PERFORMANCE BIT
#SEQ22   EQU      %
         MTW,0    #SEQEF            TEST THE ERROR FLAG
         BEZ      #SEQ24            NO ERRORS DETECTED
         MTW,1    #TMERROR          INCREMENT ERROR COUNT
         MTW,0    #SEQINH           TEST THE INHIBIT FLAG
         BEZ      #SEQ25
#SEQ24   EQU      %
         MTW,0    #TRACE            TEST THE TRACE FLAG
         BEZ      #SEQ31            B: NO TRACE REQUIRED
         MTW,0    #SEQINH
         BNEZ     #SEQ31
#SEQ25   EQU      %
         SEND     #SEQET6
         LW,R15   #DEVADR
         STW,R15  :D                MOVE DEVICE ADDRESS
         LW,R15   #SEQEF
         STW,R15  :D+1              MOVE ERROR FLAG
         MVW      #PCNT,:D2
         BAL,R15  ERROR
         NOP      WA(#SEQET2)
#SEQ26   EQU      %
         LW,7     #SEQPERF
         STW,7    #SEQP1+1
         STW,7    #SEQP2+1
         LW,R7    #SEQEF            GET THE ERROR FLAG
         AND,R7   #SEQPERF          OBTAIN TEST RESULT
         STW,R7   #SEQCEF           SET/RESET CURRENT ERROR FLAG
         BEZ      #SEQ27
         SEND     #SEQET4
         B        #SEQ28
#SEQ27   SEND     #SEQET5
#SEQ28   EQU      %
         LW,R7    *#SEQTABB         GET TEST SUBR ADR
         B        *R7
#SEQRP   LW,R7    #SEQPERF          GET CURRENT PERFORMANCE BIT
         AW,R7    R7                SHIFT LEFT BY 1
         STW,R7   #SEQPERF          SAVE UPDATED PERFORMANCE BIT
         MTW,1    #SEQTCNT          INCR. TEST SUBROUTINE COUNTER
         MTW,1    #SEQTABB          INCR TEST SUBR. TABLE ADR
         LW,R7    #SEQTABB          GET TEST SUBR TABLE ADR
         CW,R7    #SEQTABA          TEST FOR END OF CURRENT TM
         BL       #SEQ26            GO TO NEXT TEST SUBROUTINE
         BAL,R15  ERROR             LAST CALL TO ERROR
         NOP      WA(#SEQET3)
#SEQ31   EQU      %
         LCFI     0
         LM,0     #SEQSAVE
         MTW,0    #SEQEF            TEST THE ERROR FLAG
         BEZ      *7                EXIT
         MTW,0    #SEQINH
         BNEZ     *7
         MTW,0    #SEQTERM          TEST THE TERMINATION FLAG
         BNEZ     #EXIT             TERMINATE TM FOR CURRENT DEV.
         B        *7                EXIT
*
*
*
*
***************************************************************
*        *** DEVICE INDEPENDANT COMMON  GENERAL SUBROUTINES ***
***************************************************************
*
*
***************************************************************
*        *** TIO/HIO/TDV - SUBROUTINE ***
***************************************************************
*
*      THIS SUBROUTINE EXECUTES TIO,HIO AND TDV INSTRUCTIONS AND
*      returns device status, operational status, and condition
*      code. The operational status is the status of
*      the last I/O operation!
*      The condition code is masked out in the SUBROUTINES
*      with X'E0' for TAURUS and Sigma 8-9 and with x'C0' for
*      Sigma 5-7.
*
*
*      Calling Sequence
*
*                  LW,0      =IOCDX04  LOAD IOCD  WORD ADDRESS
*                  BAL,7     TIO       BRANCH....
*
*
*      Parameters
*
*      #DEVADR     Device Address
*
*
*      Registers
*
*                  REG.5     BYTE COUNT(TDV), DEVICE ADR(AIO)
*                  REG.6     IOCD ADDRESS(TDV)
*                  REG.7     STATUS/CONDITION CODE
*
*
*
TIOS     RES      1                 SAVE ADDRESS
*
*
TIO      LI,5     0                 LOAD TIO INDEX
         B        TIO1
*
HIO      LI,5     1                 LOAD HIO INDEX
         B        TIO1
*
TDV      LI,5     2
         B        TIO1              LOAD TDV INDEX
*
TIO1     STW,7    TIOS              SAVE RETURN ADDRESS
         LCI      0
         STM,R0   FDPREGS           SAVE THE FDP'S REGISTERS
         DO       SIM
         LI,R6    0
         LI,R7    0
         B        TIO6
         FIN
         B        %+1,R5            DECODE INSTRUCTION TYPE-CODE
         B        TIOEX
         B        HIOEX
         B        TDVEX
*
TIOEX    RES
         M:BLIST  F:DIAG,(TIO)      EXECUTE TIO
         B        TIO4              STORE RETURNS AND RETURN
*
HIOEX    RES
         M:BLIST  F:DIAG,(HIO)      ..HAS BEEN UPDATED FOR IOINST.
         B        TIO4              STORE RETURNS AND RETURN
*
TDVEX    RES
         M:BLIST  F:DIAG,(TDV)
         B        TIO4
*
TIO4     RES
         LCI      0
         LM,R0    FDPREGS           RESTORE FDP'S REGISTERS
         LW,R6    STATUS+1          FETCH IO EVEN REGISTER
         LW,R7    STATUS+2          FETCH IO ODD REGISTER
         LB,R15   STATUS+3          GET CONDITION CODES
         AND,R15  XF0               MASK FOR CC'S ONLY
TIO6     RES
         STW,7    5                 SAVE FOR BYTE COUNT / IO ADDRESS
         AND,7    =X'FFFF0000'      MASK OUT BC/IOADR
         AND,15   #CCMASK           MASK BIT 3 OF COND CODE
         STB,15   7,3                 AND SAVE CONDITION CODE
         AND,5    =X'FFFF'          MASK OUT STATUS
         B        *TIOS             RETURN
*
*
**************************************************************
*      DEVRDY - Subroutine
**************************************************************
*
*
*      The DEVRDY subroutine waits for the device and the controller to
*      get ready. TIO instructions are issued to check
*      the device.
*      The DEVRDY subroutine uses the SCNT subroutine, which
*      arms and enables counter 4 interrupt and counter 4 = 0
*      interrupt, and uses the HCNT subroutine, which disarms
*      and disables all interrupts.
*
*
*      Calling Sequence
*
*                  BAL,7     DEVRDY
*
DEVRDYS  RES      1                 RETURN ADDRESS
*
DEVRDY   EQU      %
         STW,7    DEVRDYS           SAVE RETURN ADDRESS
         LI,4     -1024             LOAD TIME OUT VALUE
DEVRDY1  RES
         M:WAIT   1
         BAL,7    TDV                   ISSSUE TIO
         AND,7    =X'04000000'
         BNEZ     *DEVRDYS          RETURN
         BIR,4    DEVRDY1           LOOP
         MTW,1    #TIMEOUT          SET TIMEOUT FLAG
         B        *DEVRDYS          RETURN
*
*
**************************************************************
*      RAND - Subroutine
**************************************************************
*
*      The RAND subroutine calculates a random binary number.
*      The value in parameter #SEED is modified to the
*      new value.
*
*      Calling Sequence
*
*                  BAL,7     RAND
*
*      Parameters
*
*      #SEED       Random number
*
RANDK    DATA     57727665          GAMMA-CONSTANT
RANDM    DATA     31479265          CONSTANT PI
RANDN    DATA     57727665          CONSTANT GAMMA
RANDS    RES      1
*
RAND     EQU      %
         STW,7    RANDS
         MTW,1    RANDM
         BCR,3    %+2
         MTW,-1   RANDN             DECREMENT COUNTER N
         LW,14    #SEED             LOAD SEED
         SCS,14   13                SHIFT #SEED
         EOR,14   RANDK             ADD CONSTANT
         EOR,14   RANDM             COMBINE WITH COUNTER M
         EOR,14   RANDN             COMBINE WITH COUNTER N
         STW,14   #SEED             STORE SEED
         B        *RANDS
*
*
**************************************************************
*      IOEX - Subroutine
**************************************************************
*
*      The IOEX subroutine executes a sequence of SIO,
*      AIO, TIO, and TDV instructions.
*      The IOEX subroutine can only be used if an interrupt
*      is generated, either a controller interrupt (interrupt
*      on channel end, interrupt on zero byte count ) or
*      a device interrupt (on cylinder/ on sector interrupt,
*      attention interrupt).
*      In case of "SIO rejected" and "Timeout"
*      THE TEST MODE BUFFER IS CHECKED, IF IT IS NOT EQUAL
*      ZERO THE ABORT FLAG
*      #SEQAF is set, which will result in an immediate termination
*      of the test sequence execution.
*      All significant data are stored in a data base.
*      This data base contains the IOCD address, the masks,
*      the expected states, and the expected condition codes
*      for SIO, AIO, TDV, and TIO.
*      The data base also contains locations where to store
*      the observed states and condition codes.
*      The IOEX subroutine modifies the expected data of the
*      AIO address and the mask of the AIO and TDV condition
*      code. The device address value from location
*      #DEVADR is stored as expected AIO device address.
*      THE DATA BASE MODIFIER FLAG (#DBMF) CONTROLS THE
*      MODIFICATION OF THE AIO AND TDV CONDITION CODES FOR
*      TESTMODE. IF IT IS ZERO THE DATA BASE IS NOT MODIFIED. IF
*      IT IS NOT ZERO, THE TEST MODE FLAG   IS CHECKED AND THE
*      CONDITION CODES OF AIO AND TDV ARE SET TO X'40' IF
*      THE FLAG   IS NOT ZERO AND IT IS SET TO X'00' IF
*      THE FLAG   IS ZERO.
*      After the execution of the individual I/O instructions
*      the IOEX subroutine saves the states and condition codes
*      for SIO, TIO, AIO, and TDV.
*      The subroutine also saves the observed address for
*      the AIO and the observed IOCD address
*      and the bytecount for the TDV.
*
*      Calling Sequence
*
*                  LW,4      =DATABASE           LOAD DATA BASE ADDR
*                  BAL,7     IOEX                BRANCH AND LINK
*
*
*      Parameters
*
*      REG.4       Address of data base
*      #DEVADR     Device address
*      #DELAY      Delay time in seconds
*      #DBMF       DATA BASE MODIFIER FLAG
*      #TMF        TESTMODE FLAG
*      *
*      #TIMEOUT    Timeout flag
*      #SEQAF      Abort flag, set if SIO not accepted
*                            or if timeout.
*      #ODELAY     Observed Delay Time in Milliseconds
*
*
*      Subroutines
*
*      SIO,AIO,TIO, HIO,TDV, and WAITI
*
*
*
*      DATABASE    EQU       %
*      *
*        DATA     IOCDX13           IOCD WORD        ADDRESS
*        DATA     X'970000E0'       SIO MASK
*        DATA     X'10000000'       SIO EXPECTED STATUS/COND.CODE
*        DATA     0                 SIO OBSERVED STATUS/COND.CODE
*        DATA     X'FFFF00E0'       AIO MASK
*        DATA     X'00100000'       AIO EXPECTED STATUS/COND.CODE
*        DATA     0                 AIO OBSERVED STATUS
*        DATA     X'FFFFFFFF'       AIO MASK FOR IO ADDRESS
*        DATA     0                 AIO EXPECTED IO ADDRESS
*        DATA     0                 AIO OBSERVED IO ADDRESS
*        DATA     X'FFFF00E0'       TIO MASK
*        DATA     X'10000000'       TIO EXPECTED STATUS/COND.CODE
*        DATA     0                 TIO OBSERVED STATUS/COND.CODE
*        DATA     X'FFFF00E0'       TDV MASK
*        DATA     X'00000000'       TDV EXPECTED STATUS/COND.CODE
*        DATA     0                 TDV OBSERVED STATUS/COND.CODE
*        DATA     X'0000FFFF'       TDV MASK FOR BYTE COUNT
*        DATA     0                 TDV EXPECTED BYTE COUNT
*        DATA     0                 TDV OBSERVED BYTE COUNT
*        DATA     X'FFFFFFFF'       TDV MASK FOR IOCD ADDRESS
*        DATA     DA(IOCDX13)       TDV EXPECTED IOCD ADDRESS
*        DATA     0                 TDV OBSERVED IOCD ADDRESS
*        DATA     0                 DELAY TIME/TIME FLAG
*
*
IOEXS    RES      1                 RETURN ADDRESS
IOEXB    RES      1                 DATA BASE ADDRESS
*
IOEX     EQU      %
         STW,7    IOEXS
         STW,4    IOEXB             SAVE DATA BASE ADDRESS
         STW,0    22,4
         LW,7     #DEVADR              EXPECTED IO ADDRESS
         STW,7    8,4
         MTW,0    #DBMF             CHECK IF DATA BASE SHALL
         BEZ      IOEX1               BE MODIFIED: NO
         LI,6     0
         MTW,0    #TMF              CHECK TEST MODE FLAG
         BEZ      %+2               NO TEST MODE: SET CC=0
         LI,6     X'40'             TEST MODE: SET CC2=1
         LW,7     5,4               MODIFY
         AND,7    =X'FFFFFFBF'        CONDITION CODE
         OR,7     6                     FOR AIO
         STW,7    5,4                     AND STORE IT IN DATA BASE
         LW,7     14,4              MODIFY
         AND,7    =X'FFFFFFBF'        CONDITION CODE
         OR,7     6                     FOR TDV
         STW,7    14,4                    AND STORE IT IN DATA BASE
IOEX1    EQU      %
         LW,5     #DELAY            LOAD DELAY VALUE
         LW,6     #DEVADR            AND DEVICE ADDRESS FOR ON LINE
         LCI      0
         STM,R0   FDPREGS           SAVE FDP'S REG. VALUES
         LW,R14   TMI               GET CURRENT TM NUMBER
         BAL,R15  HEXTOEBC          CONVERT TO EBCDIC
         STH,R13  WARNING+6         STUFF BAD TYPE CODE MSG
*
         DW,R5    TIMEX             DIVIDE CNT BY DECIMAL 4800
         BCS,2    %+2               BRANCH IF QUOTIENT IS POSITIVE
         LI,R5    1                 OTHERWISE, SET DEFAULT COUNT
         STW,R5   DELAY             SET M:BLIST TIMEOUT VALUE
         LW,R15   0,R4              GET IOCD ADDRESS
         STW,R15  CDLIST            STORE FOR M:BLIST ACCESS
         LW,R8    20,R4             SET CMND DBLWRD ADR EXP INTO OBS
         LW,R9    2,R4              SET SIO OBS=SIO EXPECTED
         LW,R10   5,R4              SET HIO/AIO OBSERVED = EXPECTED
         LW,R11   8,R4              SET OBSERVED = EXPECTED
         LW,R12   11,R4             OTHERWISE, SET TIO OBS = EXP
         LW,R13   14,R4             OTHERWISE, SET EXPECTED = OBSERVED
         LW,R14   17,R4             IF NOT, SET BC OBS = BC EXPECTED
         DO       SIM
         LI,R5    -1
         STW,R5   22,R4
         B        IOEX8
         FIN
*
         M:BLIST  F:DIAG,;          BUILD CMND LIST IN F:DIAG DCB
                  (ADR,*CDLIST),;   ADDRESS OF CMND DBLWD LIST
                  (PRI,*PRI),;      ADDRESS OF PRIORITY VALUE
                  (TIMEOUT,*DELAY),;  ADDRESS OF TIMEOUT COUNT
                  (SIO)             SPECIFY SIO EXECUTION
         LB,R15   STATUS            GET THE TYPE CODE
         CI,R15   X'14'             WAS I/O OPERATION SUCCESSFUL
         BE       IOEX4             YES, STR RETURNS & EXIT
         CI,R15   X'15'             WAS THERE A DEVICE ERROR
         BE       IOEX4             IF SO, BRANCH
         CI,R15   X'11'             WAS SIO REJECTED
         BE       IOEX3             IF SO, BRANCH
         CI,R15   X'12'             DID I/O TIME OUT
         BNE      IOEX2             SUMPIN'S WRONG WITH THE TYPE COD
         LW,R5    DELAY
         MI,R5    1800
         STW,R5   22,R4             SET VALUE IN FDP DATA BASE
         B        IOEX5             SAVE RETURNS AND EXIT
*
*        ENTER HERE IF TYPE CODE WAS OTHER THAN X'11,12 OR 14'
*
IOEX2    LW,R14   R15               LOAD HEX TO BE CONVERTED IN R13
         BAL,R15  HEXTOEBC          CONVERT
         STH,R13  WARNING+4         STUFF EBCDIC IN WARNING MSG
         M:TYPE   (MESS,WARNING)    OUTPUT WARNING
         B        IOEX4             PROCEED AS IF NORMAL COMPLETION
*
*        ENTER HERE IF TYPE CODE = X'11' (SIO REJECTED)
*
IOEX3    LW,R9    STATUS+2          GET OBSERVED SIO STATUS & CC
         AND,R9   YFFFF             MASK FOR SIO STATUS
         LB,R15   STATUS+3,1        FETCH SIO COND. CODE
         OR,R9    R15               COMBINE STATUS AND CC
         B        IOEX6             SAVE RETURNS AND EXIT
*
*        ENTER HERE IF TYPE CODE = X'14' (SIO COMPLETION)
*
IOEX4    MTW,-1   22,R4             SET TIME TO MINUS ONE
         LH,R11   STATUS+2,R1       GET AIO OBS I/O ADDR.
*
*        ENTER HERE IF TYPE CODE = X'12' (SIO TIMEOUT)
*
IOEX5    LW,R10   STATUS+2          GET AIO/HIO OBS STATUS
         AND,R10  YFFFF             MASK FOR OBS STATUS
         LB,R15   STATUS+3,R1       GET AIO/HIO COND. CODES
         OR,R10   R15               COMBINE STATUS AND CC
         LW,R12   STATUS+8          GET TIO STATUS
         AND,R12  YFFFF             MASK FOR STATUS
         LB,R15   STATUS+3,R3       GET TIO CC'S
         OR,R12   R15               COMBINE CC AND STATUS
IOEX6    LW,R13   STATUS+5          GET TDV OBSERVED STATUS
         AND,R13  YFFFF             MASK FOR TDV OBS STATUS
         LB,R15   STATUS+3,R2       GET TDV OBSERVED CC
         OR,R13   R15               COMBINE STATUS AND CC
         LH,R14   STATUS+5,R1       GET TDV OBSERVED BYTE COUNT
         LI,R0    0
         STW,R0   19,R4             SET IOCD MASK TO ZERO
         LW,R8    STATUS+4          GET TDV STATUS; IOCD
         AND,R8   XFFFFFF           MASK OFF SUBCHANNEL STATUS
*
*        ENTER HERE IF RUNNING IN SIMULATION
*
IOEX8    RES
         STW,R8   21,R4             STR TDV OBS IOCD ADDRESS
         STW,R9   3,R4              STR SIO OBS STATUS & CC
         STW,R10  6,R4              STR AIO/HIO OBS STATUS
         STW,R11  9,R4              STR AIO OBS IO ADDR.
         STW,R12  12,R4             STR TIO OBS STATUS & CC
         STW,R13  15,R4             STR TDV OBS STATUS & CC
         STW,R14  18,R4             STR TDV OBS BYTE COUNT
         LCI      0
         LM,0     FDPREGS           RESTORE FDP REG. VALUES
         MTW,0    22,4              CHECK TIMEOUT VALUE
         BL       *IOEXS            RETURN
         MTW,1    #SEQAF            SET ABORT FLAG
         B        *IOEXS            RETURN FROM ON LINE
*
*
*
**************************************************************
*      IOTEST - Subroutine
**************************************************************
*
*      The IOTEST subroutine tests the IO data of
*      a data base.
*      Expected and observed data are masked before a
*      comparison is made.
*      In case of any error the #SEQCER flag is set.
*
*      Calling Sequence
*
*                  LW,4      =DATABASE           LOAD DATA BASE ADDR
*                  BAL,7     IOTEST              BRANCH AND LINK
*
*      Parameters
*
*      REG.4       Address of data base
*      *
*      #SEQCER     CURRENT ERROR FLAG
*
IOTESTS  RES      1                 RETURN ADDRESS
*
IOTEST   EQU      %
         STW,7    IOTESTS           SAVE RETURN ADDRESS
         LI,5     7                 LOAD INDEX
IOTEST1  LW,6     2,4               LOAD EXPECTED VALUE
         LW,7     3,4               LOAD OBSERVED VALUE
         AND,6    1,4               AND EXP. VALUE WITH MASK
         AND,7    1,4               AND OBS. VALUE WITH MASK
         CW,6     7                 COMPARE MASKED EXP. WITH MASKED OBS.
         BE       %+2               OK
         MTW,1    #SEQCEF           SET ERROR FLAG
         AI,4     3                 INCR. INDEX
         BDR,5    IOTEST1           DECR. INEX
         MTW,0    #SEQAF            CHECK ABORT FLAG
         BEZ      %+2               OK
         MTW,1    #SEQCEF           SET ERROR FLAG
         B        *IOTESTS          RETURN
*
*
**************************************************************
*      IOCDP - Subroutine
**************************************************************
*
*      The IOCDP subroutine prints the IOCD address and the
*      IOCD. Up to 16 IOCDs will be printed, if data or command
*      chaining flags are set or if the order is a transfer
*      in channel.
*
*      Calling Sequence
*
*                  LI,4      IOCDX02  IOCD WORD ADDRESS
*                  BAL,7    IOCDP                         PRINT
*
IOCDPS   RES      1
*
IOCDPET1 ETAB     3,:D,3,:H1
*
IOCDP    EQU      %
         STW,7    IOCDPS            SAVE RETURN ADDRESS
         LI,15    X'50'
         STB,15   IOCDPET1+1
IOCDP1   STW,4    :D                STORE IOCD ADDRESS IN PRINT BUFFER
         LW,6     *4                LOAD IOCD WORD 1
         STW,6    :D1                 AND STORE IT
         LW,7     *4,1              LOAD IOCD WORD 2
         STW,7    :D2                 AND STORE IT
         SEND     IOCDPET1          PRINT
         LI,15    X'30'
         STB,15   IOCDPET1+1
         AND,7    =X'A0000000'      CHECK FOR COMMAND/DATA CHAINING
         BEZ      IOCDP2            NO
         AI,4     2                 YES: INCREMENT IOCD WORD ADDRESS
         B        IOCDP1            LOOP
*
IOCDP2   LB,7     6                 CHECK ORDER BYTE
         CI,7     8                 IS IT A TRANSFER IN CHANNEL?
         BNE      IOCDP9            NO
         AND,6    =X'FFFF'          LOAD NEXT IOCD ADDRESS
         AW,6     6                 CALCULATE WORD ADDRESS
         CW,6     4                 COMPARE WITH PRESENT IOCD ADDRESS,
         BL       IOCDP9              IF LESS DO NOT LOOP
         LW,4     6                     ELSE LOAD ADDRESS IN REG.4
         B        IOCDP1                  AND LOOP
*
IOCDP9   B        *IOCDPS
*
*
*
**************************************************************
*      IOPR - Subroutine
**************************************************************
*
*      The IOPR subroutine prints the data of the data
*      base in three different ways, depending on the
*      type of error.
*
*      Calling Sequence
*
*                  LW,4      =DATABASE           LOAD DATA BASE ADDR
*                  BAL,7     IOPR             BRANCH AND LINK
*
*      Parameters
*
*      REG.4       Address of data base
*      #SEQCER     CURRENT ERROR FLAG
*
IOPRET3  ETAB,3   21,:D,7,:H10
IOPRET5  ETAB     2,:D,2,:H8
IOPRET6  ETAB     6,:D,6,:H18
*
IOPRS    RES      1                 RETURN ADDRESS
IOPRB    RES      1                 DATA BASE ADDRESS
*
IOPR     EQU      %
         STW,7    IOPRS
         STW,4    IOPRB             SAVE RETURN ADDRESS
*
IOPR1    LW,4     *4                LOAD IOCD ADDRESS
         BAL,7    IOCDP             BRANCH TO IOCD PRINT SUBROUTINE
         LW,4     IOPRB             LOAD DATA BASE
         LW,7     22,4              GET TIMEOUT VALUE
         BGEZ     IOPR6             SIO REJECTED OR TIMEOUT
*
         LW,5     2,4               LOAD EXP. SIO/TIO STATUS
         AND,5    1,4               AND IT WITH MASK
         LW,6     3,4               LOAD OBS. SIO/TIO STATUS
         AND,6    1,4               AND IT WITH MASK
         LW,7     3,4               LOAD OBS. SIO/TIO STATUS
         STW,5    :D
         STW,6    :D+7
         STW,7    :D+14
*
         LW,5     5,4               LOAD
         AND,5    4,4                 AND
         LW,6     6,4                  PREPARE
         AND,6    4,4                        AIO
         LW,7     6,4                           STATUS
         STW,5    :D1
         STW,6    :D1+7
         STW,7    :D1+14
*
         LW,5     8,4               LOAD
         AND,5    7,4                 AND
         LW,6     9,4                  PREPARE
         AND,6    7,4                   CONDITION CODE
         LW,7     9,4                                 FOR
         STW,5    :D2
         STW,6    :D2+7
         STW,7    :D2+14
*
         LW,5     11,4              LOAD
         AND,5    10,4                AND
         LW,6     12,4                 PREPARE
         AND,6    10,4                      TDV
         LW,7     12,4                       STATUS,
         STW,5    :D3                           IOCD ADDRESS,
         STW,6    :D3+7                             AND BYTE COUNT
         STW,7    :D3+14
         LW,5     14,4
         AND,5    13,4
         LW,6     15,4
         AND,6    13,4
         LW,7     15,4
         STW,5    :D4
         STW,6    :D4+7
         STW,7    :D4+14
         LW,5     17,4
         AND,5    16,4
         LW,6     18,4
         AND,6    16,4
         LW,7     18,4
         STW,5    :D5
         STW,6    :D5+7
         STW,7    :D5+14
         LW,5     20,4
         AND,5    19,4
         LW,6     21,4
         AND,6    19,4
         LW,7     21,4
         STW,5    :D6
         STW,6    :D6+7
         STW,7    :D6+14
         SEND     IOPRET3           PRINT MESSAGE
         B        *IOPRS
*
IOPR6    EQU      %                 PREPARE MESSAGE
         LW,7     3,4                    FOR SIO REJECTED OR TIMEOUT
         STW,7    :D
         LW,7     6,4
         STW,7    :D4
         LW,7     12,4
         STW,7    :D5
         LW,7     15,4
         STW,7    :D1
         LW,7     18,4
         STW,7    :D2
         LW,7     21,4
         STW,7    :D3
         SEND     IOPRET6
         MVW      K3,:D
         LW,7     22,4
         STW,7    :D1
         SEND     IOPRET5
         B        *IOPRS
*
*
*
**************************************************************
*      PAT - Subroutine
**************************************************************
*
*      The PAT subroutine spreads a data pattern
*      in a buffer.
*      With parameters the user has control over the pattern
*      type, the data  which are spread, the buffer
*      location, and the buffer length.
*      The pattern seed will be taken from the pattern
*      buffer. The increment value is taken from the second
*      word of the pattern buffer. (The location @PBUF
*      will contain the address of the pattern buffer.)
*      In case #BUFLEN is not multiple of 4, the data are spread to
*      the next word boundary. If pattern 3-5 are selected, and the
*      value of #BUFLEN is not multiple 8,12, or 16 bytes, data are
*      spread unto the next 8, 12, or 16 byte boundary.
*
*      Calling Sequence
*
*                  BAL,7     PAT
*
*      Parameters
*
*      @BUF        ADDRESS OF BUFFER WORD ADDRESS
*      #BUFLEN     BUFFER LENGTH IN BYTES
*      #PTYP       PATTERN TYPE
*      @PBUF       ADDRESS OF PATTERN BUFFER ADDRESS
*
*      Pattern Types
*
*      0           Fixed one word pattern
*      1           Incremented one word pattern
*      2           Random one word pattern
*      3           Fixed 3 word  pattern
*      4           Fixed 16 byte pattern
*      5           Fixed 8 byte pattern
*        5         Program error
*
*
*
PATS     RES      1                 RETURN ADDRESS
PATB     RES      1                 BUFFER ADDRESS (TOP)
PATH     RES      1                 BUFFER ADDRESS (TOP OF 1. HALF)
PATM     RES      1                 RANDOM NUMBER STORAGE
*
PATP     RES      4                 PATTERN BUFFER
PATC     RES      1                 PATTERN LENGTH COUNT
PATPI    DATA     314159265         CONSTANT PI
*
*
PAT      EQU      %                 PATTERN SPREAD ROUTINE
         STW,7    PATS              SAVE RETURN ADDRESS
         LW,7     #PTYP             LOAD PATTERN TYPE
         CI,7     6                   AND CHECK FOR VALIDITY
         BL       %+2               OK
         BAL,7    PERROR            PROGRAM ERROR
         LI,6     0                 TRANSFER PATTERN
         LW,7     *@PBUF,6             DATA FROM PATTERN BUFFER
         STW,7    PATP,6                  TO LOCAL PATTERN BUFFER
         AI,6     1
         CI,6     4
         BL       %-4
         LW,7     #BUFLEN           CALCULATE
         AI,7     3                    THE CORRECT
         SLS,7    -2                    PATTERN LENGTH
         STW,7    PATC                    IN WORDS
         AW,7     @BUF              AND THE ADDRESS
         STW,7    PATB                 OF THE LAST BUFFER LOCATION
         LCW,4    PATC              LOAD THE COMLEMENT OF THE WORD COUNT
         LW,7     PATP              LOAD THE FIRST PATTERN WORD
         LW,6     #PTYP             BRANCH TO THE PATTERN SPREAD ROUTINE
         CI,6     5
         BLE      %+1,6
*
         B        PAT0              FIXED PATTERN
         B        PAT1              INCREMENTED PATTERN
         B        PAT2              RANDOM PATTERN
         B        PAT3              3 WORD PATTERN
         B        PAT4              16 BYTE PATTERN
         B        PAT5              8 BYTE PATTERN
*
PAT0     STW,7    *PATB,4           STORE DATA PATTERN
         BIR,4    PAT0              LOOP
         B        *PATS             RETURN
*
PAT1     STW,7    *PATB,4           STORE DATA PATTERN
         AW,7     PATP+1            INCREMENT DATA PATERN
         BIR,4    PAT1              LOOP
         B        *PATS             RETURN
*
PAT2     LW,5     PATB              LOAD ADDRESS
         SAS,4    -1                DIVIDE WORD COUNT
         AW,5     4                    AND ADD IT TO ADDRESS
         STW,5    PATH                  AND STORE IT
         LW,5     PATPI             LOAD CONSTANT PI
         STW,5    PATM                AND STORE IT
PAT2A    STW,7    *PATH,4           STORE DATA PATTERN IN 1. HALF
         EOR,7    =-1               TAKE 1'S COMPLEMENT
         STW,7    *PATB,4             AND STORE IT IN 2. HALF OF BUFFER
         SLS,7    7                 BUILD THE NEXT RANDOM
         SW,7     *PATB,4                            NUMBER
         XW,7     PATM
         AW,7     PATM
         BIR,4    PAT2A             LOOP
         B        *PATS             RETURN
*
PAT3     LI,4     3                 THREE WORD PATTERN
         B        PAT8
*
PAT4     LI,4     4                 16 BYTE PATTERN
         B        PAT8
*
PAT5     LI,4     2                 8 BYTE PATTERN
         B        PAT8
*
PAT8     EQU      %
         MVW      @BUF,PATH         SET THE BUFFER ADDRESS
         LI,6     0                 CLEAR REG. 6
         LW,7     PATC               AND CALCULATE THE
         DW,6     4                    LOOP COUNT FOR 3,4, AND 8 WORD
         MTW,0    6                     REPETITIVE PATTERNS
         BEZ      %+2               NO REMAINDER
         AI,7     1                 ELSE ADJUST TO CHECK ALL BYTES
         STW,7    PATC                AND SAVE THE COUNT
PAT81    LI,6     0                 RESET INDEX
         LW,7     PATP,6            GET PATTERN
         STW,7    *PATH,6               AND STORE IT IN BUFFER
         AI,6     1                 INCR. INDEX
         CW,6     4                  AND COMPARE WITH PATTERN LENGTH
         BL       %-4               LOOP
         AWM,4    PATH              UPDATE BUFFER ADDRESS
         MTW,-1   PATC              DECREMENT WORD COUNT
         BGEZ     PAT81             LOOP
         B        *PATS             RETURN
*
*
*
*
**************************************************************
*      COM - Subroutine
**************************************************************
*
*      The COM subroutine compares the data of two buffers.
*      Three parameters give the user control over the selected
*      buffers and the length of the buffers.
*      The result of the comparison is returned in another
*      parameter, which contains the number of erroneous words.
*      If #BUFLEN is not multiple 4, all bytes up to the next
*      word boundary are compared.
*
*      PARAMETERS
*
*      @BUF1       ADDRESS OF BUFFER 1 ADDRESS
*      @BUF2       ADDRESS OF BUFFER 2 ADDRESS
*      #BUFLEN     LENGTH OF BUFFERS IN BYTES
*      *
*      #COMERR     COUNT OF ERRONEOUS WORDS
*
*      Calling Sequence
*
*                  BAL,7     COM
*
*
COMS     RES      1                 RETURN ADDRESS
COMC     RES      1                 COMPARISON COUNT
*
COM      EQU      %
         STW,7    COMS              SAVE RETURN ADDRESS
         STW,0    #COMERR           RESET COMPARE ERROR FLAG
         LW,7     #BUFLEN           GET BUFFER LENGTH (IN BYTES)
         AI,7     3                    AND CONVERT TO WORD LENGTH
         SLS,7    -2
         STW,7    COMC
         LI,4     0                 RESET INDEX
COM1     LW,7     *@BUF1,4          LOAD DATA WORD
         CW,7     *@BUF2,4            AND COMPARE WITH OBSERVED WORD
         BE       %+2               OK
         MTW,1    #COMERR           SET ERROR FLAG
         AI,4     1                 INCR. INDEX
         CW,4     COMC              COMPARE WITH WORD COUNT
         BL       COM1              LOOP
         B        *COMS             RETURN
*
*
*
*
**************************************************************
*      COMP - Subroutine
**************************************************************
*
*      The COMP subroutine compares the data of two buffers
*      and prints the contents  of these buffers.
*      Three parameters give the user control over the selected
*      buffers and the length of the buffers.
*      The result of the comparison is returned in another
*      parameter, which contains the number of erroneous words.
*      A fourth parameter specifies whether the whole
*      buffer contents (#COMLIM=0) or only the erroneous words are
*      printed.
*      If #BUFLEN is not multiple 4, all bytes up to the next
*      word boundary are compared.
*
*      PARAMETERS
*
*      @BUF1       ADDRESS OF BUFFER 1 ADDRESS
*      @BUF2       ADDRESS OF BUFFER 2 ADDRESS
*      #BUFLEN     LENGTH OF BUFFERS IN BYTES
*      #COMLIM     PRINT LIMIT FLAG
*      *
*      #COMERR     COUNT OF ERRONEOUS WORDS
*
*      Calling Sequence
*
*                  BAL,7     COMP
*
*
*
*
COMPH    RES      1
COMPC    RES      1
COMPS    RES      1
*
*
* ERROR TABLE:
*
COMPET1  ETAB     5,:D,5,:H15
COMPET2  GEN,8,24 5,:D
         GEN,8,24 X'30',0
         GEN,8,24 0,:H15
*
*
*
COMP     EQU      %
         STW,7    COMPS             SAVE RETURN ADDRESS
         STW,0    COMPH             RESET HEADER FLAG
         STW,0    #COMERR             AND ERROR COUNT
         LW,7     #BUFLEN           CALCULATE
         AI,7     3                      THE WORD COUNT
         SLS,7    -2                       AND STORE IT
         STW,7    COMPC
         LI,4     0                 RESET INDEX 4
COMP1    EQU      %                 LOAD EXPECTED WORD
         LW,7     *@BUF1,4            AND COMPARE WITH OBSERVED WORD
         CW,7     *@BUF2,4          ERR0R: GO TO PRINT
         BNE      COMP3
         MTW,0    #COMLIM           CHECK PRINT LIMIT FLAG
         BEZ      COMP4             FLAG=0: PRINT ALL DATA
         B        COMP6             LOOP
COMP3    MTW,1    #COMERR           INCR. ERROR COUNT
COMP4    EQU      %
         LW,7     @BUF1             LOAD BUFFER ADDRESS
         AW,7     4                   AND ADD INDEX COUNT
         STW,7    :D                     AND SAVE FOR PRINTOUT
         LW,7     *7                LOAD EXP. DATA
         STW,7    :D1                 AND SAVE
         LW,7     @BUF2             LOAD BUFFER ADDRESS
         AW,7     4                   ADD THE INDEX COUNT
         STW,7    :D2                    AND SAVE
         LW,7     *7                LOAD DATA
         STW,7    :D3                  AND SAVE
         STW,4    :D4               SAVE INDEX COUNT
         MTW,0    COMPH             CHECK HEADER FLAG
         BEZ      COMP5              =0: PRINT HEADER
         SEND     COMPET2           PRINT DATA WITHOUT HEADER
         B        COMP6             LOOP
COMP5    SEND     COMPET1           PRINT DATA WITH HEADER
         MTW,1    COMPH             INC. HEADER FLAG
*
COMP6    AI,4     1                 INCR. INDEX COUNT
         CW,4     COMPC             COMPARE WITH WORD COUNT
         BL       COMP1             IF LESS : LOOP
         B        *COMPS              ELSE RETURN
*
*
*
*
**************************************************************
*        *** PERROR - SUBROUTINE ***
**************************************************************
*
*        THE PERROR SUBROUTINE IS USED TO REPORT PARAMETER
*        ERRORS, PROGRAM ERRORS AND OTHER ERRONEOUS CONDITIONS.
*        THE LINK ADDRESS IN REGISTER 7 IS DISPLAYED.
*
*        CALLING SEQUENCE:
*                 BAL,7      PERROR
*
*
PERRORM  EQU      %
         TEXT     'PARAMETER ERROR   AT LOC.:      '
         DATA     0
*
PERROR   B        %+1
         B        %+1
         LW,12    7                 LOAD BRANCH AND LINK ADDRESS
         BAL,15   HEX                 AND CONVERT IN HEX. PRINTOUT
         STW,15   PERRORM+7             AND STORE IN ERROR MESSAGE
         BAL,15   *#REPORT          PRINT MESSAGE
         NOP      PERRORM,1
         B        #SKIP             RETURN TO DPS LAG
*
*
*
**************************************************************
*        *** HEX - SUBROUTINE ***
**************************************************************
*
*        THE HEX SUBROUTINE CONVERTS  THE LEAST SIGNIFICANT
*        4 HEX DIGITS OF REGISTER 12 INTO EBCDIC CHARACTERS
*        AND PLACES THE RESULT IN REGISTER 15. THE CONTENTS
*        OF REG. 12 IS SHIFTED 16 BITS TO THE RIGHT.
*
*        CALLING SEQUENCE:
*                 BAL,15    HEX
*
*        PARAMETERS:
*                 REG. 12    HEX  VALUE
*                 REG. 15    EBCDIC VALUE
*
*
HEXS     RES      1
*
HEX      EQU      %
         STW,15   HEXS
         LI,4     3                 SET INDEX TO STORE BYTES 3 THRU 0
HEX10    LI,13    X'F0'             HI-ORDER EBC FOR DIGITS 0 THRU 9
         SLD,12   -4                SHIFT IN LO-ORDER 4 BITS
         SCS,13   4                 SHIFT INTO BYTE POSITION 3
         CB,13    =X'F9000000'      CK FOR 0 THRU 9
         BLE      %+2
         AI,13    -X'39'            ADJUST FOR A THRU F
         STB,13   15,4              STORE IN RESULT
         AI,4     -1                DECREMENT STORE POSITION
         BGEZ     HEX10             LOOP UNTIL 4 DIGITS STORED
         B        *HEXS
*
*
*
**************************************************************
*        *** DEC - SUBROUTINE ***
**************************************************************
*
* THE DEC SUBROUTINE CONVERTS THE BINARY VALUE OF REG. 7
* INTO 4 EBCDIC CHARACTERS WHICH REPRESENT THE BINARY
* VALUE IN DECIMAL. THE VALUES ARE RETURNED IN
* THE REGISTERS 6 AND 7.
*
*
* CALLING SEQUENCE
*        LW,7     VALUE
*        BAL,15   DEC
*        -        -                 RETURN HERE
*
*        REGISTERS
*                 REG.7             RESULTS
*
DECR4    DATA     0
DECD     DATA     0
DECR     DATA     0
DECX     DATA     0
DECR6    DATA     0
*
DEC      STW,7    DECD              SAVE VALUE
         STW,6    DECR6
         STW,0    DECX              CLEAR LOC
         STW,15   DECR              SAVE RETURN ADDRESS
         STW,4    DECR4             SAVE R4
         LI,4     3                 GET INDEX
DECA     LW,7     DECD              GET VALUE
         STW,0    6
         DW,6     =10               DIVIDE BY TEN
         STW,7    DECD              SAVE VALUE
         STB,6    DECX,4            STORE REMAINDER IN MASK
         BDR,4    DECA              B: LESS THAN FOUR BYTE STORED
         LW,7     DECD              GET VALUE
         STB,7    DECX              SAVE VALUE
         LW,7     =X'F0F0F0F0'
         OR,7     DECX              CONVERT TO EBCDIC
         LW,4     DECR4             RESTORE R4
         LW,6     DECR6             RESTORE R6
         B        *DECR             RETURN
*
*
***************************************************************
*        *** HCOMP/HCOM - HEADER COMPARE SUBROUTINE ***
***************************************************************
*
*      The HCOMP subroutine compares the data of two buffers
*      and prints the contents  of these buffers.
*       THE HCOM SUBROUTINE COMPARES WITHOUT PRINTING.
*      Three parameters give the user control over the selected
*      buffers and the length of the buffers.
*      The result of the comparison is returned in another
*      parameter, which contains the number of erroneous words.
*      A fourth parameter specifies whether the whole
*      buffer contents (#COMLIM=0) or only the erroneous words are
*      printed.
*      If #BUFLEN is odd, one byte is compared in addition.
*
*      PARAMETERS
*
*      @HBUF1      ADDRESS OF BUFFER 1 LABEL
*      @HBUF2      ADDRESS OF BUFFER 2 LABEL
*      #HBUFLEN    LENGTH OF BUFFERS IN BYTES
*      #COMLIM     PRINT LIMIT FLAG
*      HMASK       8 BYTE FIELD OF HEADER MASK
*      #COMERR     COUNT OF ERRONEOUS WORDS
*
*      Calling Sequence
*
*                  BAL,7     HCOMP
HCOMPH   RES      1                 HEADER FLAG
HCOMPF   RES      1                 PRINT FLAG
HCOMPC   RES      1                 COMPARE LIMIT
HCOMPS   RES      1                 SAVE LOCATION
*
HCOMPET1 ETAB     6,:D,6,:H47
HCOMPET2 GEN,8,24 6,:D
         GEN,8,24 X'30',0
         GEN,8,24 0,:H47
*
HCOM     EQU      %
         STW,7    HCOMPS
         STW,0    HCOMPF
         B        HCOMP0
*
HCOMP    EQU      %
         STW,7    HCOMPS            SAVE RETURN ADDRESS
         STW,0    HCOMPH            RESET HEADER FLAG
         STW,1    HCOMPF
HCOMP0   EQU      %
         STW,0    #COMERR             AND ERROR COUNT
         LW,7     #HBUFLEN          CALCULATE
         AI,7     3                      THE WORD COUNT
         SLS,7    -2                       AND STORE IT
         STW,7    HCOMPC
         LI,4     0                 RESET INDEX 4
HCOMP1   EQU      %                 LOAD EXPECTED WORD
         LI,5     0
HCOMP2   EQU      %
         LW,6     *@HBUF1,4           AND HCOMPARE WITH OBSERVED WORD
         AND,6    HMASK,5
         STW,6    :D1               SAVE MASKED EXPECTED FOR PRINT
         LW,7     *@HBUF2,4
         STW,7    :D4               SAVE OBSERVED
         AND,7    HMASK,5
         STW,7    :D3               SAVE MASKED OBSERVED
         CW,6     7
         BNE      HCOMP3
         MTW,0    #COMLIM           CHECK PRINT LIMIT FLAG
         BEZ      HCOMP4            FLAG=0: PRINT ALL DATA
         B        HCOMP6            LOOP
HCOMP3   MTW,1    #COMERR           INCR. ERROR COUNT
HCOMP4   EQU      %
         MTW,0    HCOMPF
         BEZ      HCOMP6
         LW,7     @HBUF1            LOAD BUFFER ADDRESS
         AW,7     4                   AND ADD INDEX COUNT
         STW,7    :D                     AND SAVE FOR PRINTOUT
         LW,7     @HBUF2            LOAD BUFFER ADDRESS
         AW,7     4                   ADD THE INDEX COUNT
         STW,7    :D2                    AND SAVE
         STW,4    :D5               SAVE INDEX COUNT
         MTW,0    HCOMPH            CHECK HEADER FLAG
         BEZ      HCOMP5             =0: PRINT HEADER
         SEND     HCOMPET2          PRINT DATA WITHOUT HEADER
         B        HCOMP6            LOOP
HCOMP5   SEND     HCOMPET1          PRINT DATA WITH HEADER
         MTW,1    HCOMPH            INC. HEADER FLAG
*
HCOMP6   AI,4     1                 INCR. INDEX COUNT
         AI,5     1
         CI,5     2
         BL       HCOMP2
         CW,4     HCOMPC            HCOMPARE WITH WORD COUNT
         BL       HCOMP1            IF LESS : LOOP
         B        *HCOMPS             ELSE RETURN
*
*
*
***************************************************************
*        *** HLIST - HEADER CHECK AND LIST SUBROUTINE ***
***************************************************************
*
* THIS ROUTINE CHECKS THE SECONDARY ADDRESS FIELD OF THE HEADER
* FOR THE DEFAULT VALUE X'FFFFFFFF'. IF THE SECONDARY FIELD
* CONTAINS ANYTHING ELSE THE HLISTA COUNT IS INCREMENTED AND THE
* VALUES ARE LISTED.
*
*      PARAMETERS
*
*      @HBUF2      ADDRESS OF BUFFER 2 LABEL
*      #HBUFLEN    LENGTH OF BUFFERS IN BYTES
*
*      Calling Sequence
*
*                  BAL,7     HLIST
*
*
*
*
*
HLISTH   RES      1
HLISTA   RES      1                 ALTERNATE ADDRESS ASSIGNED COUNT
HLISTM   DATA     X'FFFFFF00'       MASK FOR SECOND WORD
HLISTC   RES      1
HLISTS   RES      1
HLISTPI  RES      1                 PRINT INHIBIT
*
HLIST    EQU      %
         STW,7    HLISTS            SAVE RETURN ADDRESS
         STW,0    HLISTA
         LW,7     #HBUFLEN          CALCULATE
         AI,7     3                      THE WORD COUNT
         SLS,7    -2                       AND STORE IT
         STW,7    HLISTC            SAVE WORD COUNT
         STW,0    HLISTH
         LI,8     -1
         LW,7     #CONTX            CHECK CONTROLLER TYPE
         CI,7     RMP
         BE       %+2
         LW,8     =X'FFFF00'
         STW,8    HLISTM
         LI,4     0                 RESET INDEX 4
HLIST1   EQU      %                 LOAD EXPECTED WORD
         LW,6     *@HBUF2,4           AND HLISTARE WITH OBSERVED WORD
         AI,4     1
         LI,8     -1
         AND,8    HLISTM
         LW,7     *@HBUF2,4
         AND,7    HLISTM
         CW,8     7
         BE       HLIST6
         MTW,1    HLISTA            INCR. ERROR COUNT
         MTW,0    HLISTPI           CHECK PRINT INHIBIT FLAG
         BNEZ     HLIST6            SKIP PRINTING
         LW,15    #CONTX            RMC/RDC PRINTS ONLY
         CI,15    RMP               ONE LINE
         BE       HLIST5
         MTW,0    HLISTH
         BNEZ     HLIST6
HLIST5   RES
         LW,7     *@HBUF2,4         GET SECONDARY ADDRESS VALUE
         BAL,R15  FHR
         MTW,1    HLISTH            INC. HEADER FLAG
*
HLIST6   AI,4     1                 INCR. INDEX COUNT
         CW,4     HLISTC            HLISTARE WITH WORD COUNT
         BL       HLIST1            IF LESS : LOOP
         B        *HLISTS             ELSE RETURN
*
*
***************************************************************
* FHR - FLAWED HEADER REPORT SUBROUTINE
***************************************************************
*
*        R6 = ALTERNATE SECTOR/TRACK
*        R7 = FLAWED SECTOR/TRACK
*        R15= LINK ADDRESS
*
         BOUND    8
FHRMS    TEXTS    'SECTOR: '
FHRMT    TEXTS    'TRACK : '
FHRM TEXTCS 'FLAWED SECTOR: XXXXXXXX  ALTERNATE SECTOR: YYYYYYYY',CR
*
FHR      RES
         PUSH     (R4,R15)
         LW,15    #CONTX            CHECK CONTROLLER TYPE
         CI,15    RMP
         BE       FHR3
         LD,10    FHRMT
         LCI      2
         STM,10   FHRM+2
         STM,10   FHRM+9
         SLD,6    8                 SHIFT RMC/RDC HEADER
         SLS,7    -8                SHIFT THE FLAWED ADR.
         STW,7    15
         AND,7    =X'FF7FFF'        BLEND OUT CYLINDER BIT
         AND,15   =X'8000'          CHECK IF IT IS SET
         BCR,3    %+2               NO
         OR,7     =X'1000000'       ELSE OR IT IN CORRECT POSITION
         B        FHR4
FHR3     RES
         LD,10    FHRMS
         LCI      2
         STM,10   FHRM+2
         STM,10   FHRM+9
         LW,R14   SKADR             SAVE THE SEEK ADDRESS
         STW,7    SKADR
         BAL,15   DECS              DECREMENT ADDRESS
         LW,7     SKADR
         STW,R14  SKADR             RESTORE THE SEEK ADDRESS
         AND,R6   =X'3FFFFFFF'      BLEND OUT ALTERNATE BIT
FHR4     RES
         LW,12    R7
         BAL,R15  HEX
         STW,R15  FHRM+5
         BAL,R15  HEX
         STW,R15  FHRM+4
         LW,12    R6
         BAL,R15  HEX
         STW,R15  FHRM+12
         BAL,R15  HEX
         STW,R15  FHRM+11
         LI,R6    FHRM
         BAL,R7   TY:M
         PULL     (R4,R15)
         B        *R15
*
***************************************************************
*      :HIO - Subroutine
***************************************************************
*      The :HIO subroutine executes a HIO instruction
*      saves the HIO status and condition code in a data base,
*      tests the result, and prints the status and the
*      condition code in the report phase.
*      Procedure
*                  :HIO      X'FFFF00E0',X'10000000'
*      Local Parameters
*      1.          Mask
*      2.          Expected status
*      Global Parameters
*      #DEVADR     Device Address
*      Subroutines
*                  HIO subroutine
*                 DATA BASE
:HIOD    EQU      %
         DATA     0                 MASK
         DATA     0                 EXP.STATUS/COND.CODE
         DATA     0                 OBS.STATUS/COND.CODE
*                 EXECUTION PART
:HIO     EQU      %
         B        :HIO5             BRANCH TO REPORT PART
         LOD      :HIOD,:HIOD+1     LOAD PARAM. IN DATA BASE
         BAL,7    HIO
         STW,7    :HIOD+2
         LW,5     :HIOD+1
         AND,5    :HIOD
         LW,6     :HIOD+2
         AND,6    :HIOD
         CW,5     6
         BNE      #SEQER
         B        #SEQOK
*                 ERROR TABLE
:HIOET   ETAB,3   3,:D,1,:H6
*                 REPORT PART
:HIO5    EQU      %
         LW,5     :HIOD+1
         AND,5    :HIOD
         LW,6     :HIOD+2
         AND,6    :HIOD
         LW,7     :HIOD+2
         STW,5    :D
         STW,6    :D+1
         STW,7    :D+2
         SEND     :HIOET            PRINT ERROR REPORT
         B        #SEQRP            RETURN TO #SEQ
*
*
**************************************************************
*      :TIO - Subroutine
**************************************************************
*      The :TIO subroutine executes a TIO instruction
*      saves the TIO status and condition code in a data base,
*      tests the result, and prints the status and the
*      condition code in the report phase.
*      Procedure
*                  :TIO      X'FFFF00E0',X'10000000'
*      Local Parameters
*      1.          Mask
*      2.          Expected status
*      Global Parameters
*      #DEVADR     Device Address
*      Subroutines
*                  TIO subroutine
*                 DATA BASE
:TIOD    EQU      %
         DATA     0                 MASK
         DATA     0                 EXP.STATUS/COND.CODE
         DATA     0                 OBS.STATUS/COND.CODE
*                 EXECUTION PART
:TIO     EQU      %
         B        :TIO5             BRANCH TO REPORT PART
         LOD      :TIOD,:TIOD+1     LOAD PARAM. IN DATA BASE
         BAL,7    TIO
         STW,7    :TIOD+2
         LW,5     :TIOD+1
         AND,5    :TIOD
         LW,6     :TIOD+2
         AND,6    :TIOD
         CW,5     6
         BNE      #SEQER
         B        #SEQOK
*                 ERROR TABLE
:TIOET   ETAB,3   3,:D,1,:H3
*                 REPORT PART
:TIO5    EQU      %
         LW,5     :TIOD+1
         AND,5    :TIOD
         LW,6     :TIOD+2
         AND,6    :TIOD
         LW,7     :TIOD+2
         STW,5    :D
         STW,6    :D+1
         STW,7    :D+2
         SEND     :TIOET            PRINT ERROR REPORT
         B        #SEQRP            RETURN TO #SEQ
*
*
**************************************************************
*        *** :IO1 - SUBROUTINE ***
**************************************************************
*      The :IO1 subroutine executes an I/O operation, checks,
*      and saves the returned status. All execution,
*      testing, and reporting is performed with general subroutines.
*      Procedure
*                  IO1       IOCDX03
*      Local Parameters
*      1.          IOCD address
*                 DATA BASE
:IO1D    EQU      %
         DATA     0                 IOCD WORD        ADDRESS
         DATA     X'970000E0'       SIO MASK
         DATA     X'10000000'       SIO EXPECTED STATUS/COND.CODE
         DATA     0                 SIO OBSERVED STATUS/COND.CODE
         DATA     X'FFFF00E0'       AIO MASK
         DATA     X'00100000'       AIO EXPECTED STATUS/COND.CODE
         DATA     0                 AIO OBSERVED STATUS
         DATA     X'FFFFFFFF'       AIO MASK FOR IO ADDRESS
         DATA     0                 AIO EXPECTED IO ADDRESS
         DATA     0                 AIO OBSERVED IO ADDRESS
         DATA     X'9FFF00E0'       TIO MASK
         DATA     X'10000000'       TIO EXPECTED STATUS/COND.CODE
         DATA     0                 TIO OBSERVED STATUS/COND.CODE
         DATA     X'FFFF00E0'       TDV MASK
         DATA     X'00000000'       TDV EXPECTED STATUS/COND.CODE
         DATA     0                 TDV OBSERVED STATUS/COND.CODE
         DATA     X'0000FFFF'       TDV MASK FOR BYTE COUNT
         DATA     0                 TDV EXPECTED BYTE COUNT
         DATA     0                 TDV OBSERVED BYTE COUNT
         DATA     X'FFFFFFFF'       TDV MASK FOR IOCD ADDRESS
         DATA     0                 TDV EXPECTED IOCD ADDRESS
         DATA     0                 TDV OBSERVED IOCD ADDRESS
         DATA     0                 DELAY TIME/TIME FLAG
*                 EXECUTION PART
:IO1     EQU      %
         B        :IO15             BRANCH TO REPORT PART
         LOD      :IO1D             LOAD PARAMETERS
         LW,6     :IO1D
         SLS,6    -1                FORM DOUBLE WORD ADDRESS
         STW,6    :IO1D+20            AND STORE IT.
         LW,4     =:IO1D            LOAD DATA BASE ADDRESS
         BAL,7    IOEX              BRANCH TO EXECUTE SUBROUTINE
         LW,4     =:IO1D            LOAD DATA BASE ADDRESS
         BAL,7    IOTEST            BRANCH TO TEST SUBROUTINE
         B        #SEQOK            RETURN TO SEQUENCER ROUTINE
*                 REPORT PART
:IO15    EQU      %
         LW,4     =:IO1D            LOAD DATA BASE ADDRESS
         BAL,7    IOPR              BRANCH TO PRINT SUBROUTINE
         B        #SEQRP            RETURN TO SEQUENCER ROUTINE
*
*
**************************************************************
*        *** :IO4B - SUBROUTINE ***
**************************************************************
*      The :IO4B subroutine executes an I/O operation, checks,
*      and saves the returned status. All execution,
*      testing, and reporting is performed with general subroutines.
*      Procedure
*                  IO4B      IOCDX83,X'08000000',X'10000000',0
*      Local Parameters
*      1.          IOCD address
*      2.          AIO exp. status/cond.code
*      3.          TIO exp. status/cond.code
*      4.          TDV exp. status/cond.code
*                 DATA BASE
:IO4BD   EQU      %
         DATA     0                 IOCD WORD        ADDRESS
         DATA     X'970000E0'       SIO MASK
         DATA     X'10000000'       SIO EXPECTED STATUS/COND.CODE
         DATA     0                 SIO OBSERVED STATUS/COND.CODE
         DATA     X'FFFF00E0'       AIO MASK
         DATA     X'00100000'       AIO EXPECTED STATUS/COND.CODE
         DATA     0                 AIO OBSERVED STATUS
         DATA     X'FFFFFFFF'       AIO MASK FOR IO ADDRESS
         DATA     0                 AIO EXPECTED IO ADDRESS
         DATA     0                 AIO OBSERVED IO ADDRESS
         DATA     X'9FFF00E0'       TIO MASK
         DATA     X'10000000'       TIO EXPECTED STATUS/COND.CODE
         DATA     0                 TIO OBSERVED STATUS/COND.CODE
         DATA     X'FFFF00E0'       TDV MASK
         DATA     X'00000000'       TDV EXPECTED STATUS/COND.CODE
         DATA     0                 TDV OBSERVED STATUS/COND.CODE
         DATA     X'00000000'       TDV MASK FOR BYTE COUNT
         DATA     0                 TDV EXPECTED BYTE COUNT
         DATA     0                 TDV OBSERVED BYTE COUNT
         DATA     X'FFFFFFFF'       TDV MASK FOR IOCD ADDRESS
         DATA     0                 TDV EXPECTED IOCD ADDRESS
         DATA     0                 TDV OBSERVED IOCD ADDRESS
         DATA     0                 DELAY TIME/TIME FLAG
:IO4BS   DATA     0
*                 EXECUTION PART
:IO4B    EQU      %
         B        :IO4B5            BRANCH TO REPORT PART
         LOD      :IO4BD,:IO4BD+5,:IO4BD+11,:IO4BD+14
         MVW      #DBMF,:IO4BS      SAVE MODIFIER FLAG
         STW,0    #DBMF             NO MODIFICATION FOR IO4B
         LW,6     :IO4BD            LOAD IOCD ADDRESS
         SLS,6    -1                FORM DOUBLE WORD ADDRESS
         STW,6    :IO4BD+20               11
         LW,4     =:IO4BD           LOAD DATA BASE ADDRESS
         BAL,7    IOEX              BRANCH TO EXECUTE SUBROUTINE
         MVW      :IO4BS,#DBMF      RESTORE MODIFIER FLAG
         LW,4     =:IO4BD           LOAD DATA BASE ADDRESS
         BAL,7    IOTEST            BRANCH TO TEST SUBROUTINE
         B        #SEQOK            RETURN TO SEQUENCER ROUTINE
*                 REPORT PART
:IO4B5   EQU      %
         LW,4     =:IO4BD           LOAD DATA BASE ADDRESS
         BAL,7    IOPR              BRANCH TO PRINT SUBROUTINE
         B        #SEQRP
*
*
**************************************************************
*        *** :IO5 - SUBROUTINE ***
**************************************************************
*      The :IO5 subroutine executes an I/O operation, checks,
*      and saves the returned status. All execution,
*      testing, and reporting is performed with general subroutines.
*      Procedure
*                  IO5       IOCDX83,X'08000000',X'10000000',0,0
*      Local Parameters
*      1.          IOCD address
*      2.          AIO exp. status/cond.code
*      3.          TIO exp. status/cond.code
*      4.          TDV exp. status/cond.code
*      5.          EXP. REMAINING BYTE COUNT
*                 DATA BASE
:IO5D    EQU      %
         DATA     0                 IOCD WORD        ADDRESS
         DATA     X'970000E0'       SIO MASK
         DATA     X'10000000'       SIO EXPECTED STATUS/COND.CODE
         DATA     0                 SIO OBSERVED STATUS/COND.CODE
         DATA     X'FFFF00E0'       AIO MASK
         DATA     X'00100000'       AIO EXPECTED STATUS/COND.CODE
         DATA     0                 AIO OBSERVED STATUS
         DATA     X'FFFFFFFF'       AIO MASK FOR IO ADDRESS
         DATA     0                 AIO EXPECTED IO ADDRESS
         DATA     0                 AIO OBSERVED IO ADDRESS
         DATA     X'9FFF00E0'       TIO MASK
         DATA     X'10000000'       TIO EXPECTED STATUS/COND.CODE
         DATA     0                 TIO OBSERVED STATUS/COND.CODE
         DATA     X'FFFF00E0'       TDV MASK
         DATA     X'00000000'       TDV EXPECTED STATUS/COND.CODE
         DATA     0                 TDV OBSERVED STATUS/COND.CODE
         DATA     X'0000FFFF'       TDV MASK FOR BYTE COUNT
         DATA     0                 TDV EXPECTED BYTE COUNT
         DATA     0                 TDV OBSERVED BYTE COUNT
         DATA     X'FFFFFFFF'       TDV MASK FOR IOCD ADDRESS
         DATA     0                 TDV EXPECTED IOCD ADDRESS
         DATA     0                 TDV OBSERVED IOCD ADDRESS
         DATA     0                 DELAY TIME/TIME FLAG
:IO5S    DATA     0
*                 EXECUTION PART
:IO5     EQU      %
         B        :IO55             BRANCH TO REPORT PART
         LOD      :IO5D,:IO5D+5,:IO5D+11,:IO5D+14,:IO5D+17
         MVW      #DBMF,:IO5S       SAVE MODIFIER FLAG
         STW,0    #DBMF
         LW,6     :IO5D             LOAD IOCD ADDRESS
         SLS,6    -1                FORM DOUBLE WORD ADDRESS
         STW,6    :IO5D+20                11
         LW,4     =:IO5D            LOAD DATA BASE ADDRESS
         BAL,7    IOEX              BRANCH TO EXECUTE SUBROUTINE
         MVW      :IO5S,#DBMF       RESTORE MODIFIER FLAG
         LW,4     =:IO5D            LOAD DATA BASE ADDRESS
         BAL,7    IOTEST            BRANCH TO TEST SUBROUTINE
         B        #SEQOK            RETURN TO SEQUENCER ROUTINE
*                 REPORT PART
:IO55    EQU      %
         LW,4     =:IO5D            LOAD DATA BASE ADDRESS
         BAL,7    IOPR              BRANCH TO PRINT SUBROUTINE
         B        #SEQRP            RETURN TO SEQUENCER ROUTINE
*
*
*
**************************************************************
*        *** :COMP - SUBROUTINE ***
**************************************************************
*      The :COMP subroutine compares two buffers and prints
*      the contents of these buffers in the report phase.
*      In case of an error only the erroneous data are printed.
*      Procedure
*                  COM
*      Local Parameters
*                  None
*      Global Parameters
*      @BUF1       ADDRESS OF BUFFER 1
*      @BUF2       ADDRESS OF BUFFER 2
*      #BUFLEN     LENGTH OF BUFFERS IN BYTES
*      #COMLIM     PRINT LIMIT FLAG
*      Subroutines
*                  COM  subroutine
*                  COMP subroutine
*                 EXECUTION PART
:COMP    EQU      %
         B        :COMP5
         BAL,7    COM
         LW,7     #COMERR
         BEZ      %+2
         MTW,1    #SEQCEF
         B        #SEQOK
*                 REPORT PART
:COMPET1 ETAB     1,:COMPD,1,:H45
:COMPET2 ETAB     4,:D,4,:H46
:COMPD   TEXT     'COMP'
:COMP5   EQU      %
         MTW,0    #SEQCEF           CHECK ERROR FLAG
         BEZ      :COMP6               IF ZERO PRINT REPORT MESSAGE
         BAL,7    COMP                    ELSE PRINT DATA
         B        #SEQRP
:COMP6   EQU      %                 REPORT MESSAGE
         SEND     :COMPET1
         MVW      @BUF1,:D0
         MVW      @BUF2,:D1
         MVW      #BUFLEN,:D2
         MVW      *@BUF2,:D3
         SEND     :COMPET2
         B        #SEQRP
*
*
**************************************************************
*        *** :WT   - SUBROUTINE ***
**************************************************************
*      The :WT subroutine performs a delay function,
*      which can be used to wait for the completion of an IO
*      operation.
*      THE VALUE OF THE TIME PRINTOUT IS IN MILLISECONDS.
*      There are four delay types:
*      Type        Significance
*      0           Delay only
*      1           Wait until controller ready
*      2           Wait until controller and device ready
*      3           Wait until interrupted
*      Procedure
*                  WT        1
*      Local Parameters
*      1.          Delay type
*      Global Parameters
*      #DEVADR     Device Address
*      #DELAY      Delay Time in Milliseconds
*      Subroutines
*                  WAITD subroutine
*                  WAITI subroutine
*                  CONRDY subroutine
*                  DEVRDY subroutine
*                 DATA BASE
:WTD     EQU      %
         DATA     0                 TYPE
         DATA     0                 OBSERVED DELAY TIME
:WTS1    DATA     0,0,DEVRDY,0
*                 EXECUTION PART
:WT      EQU      %
         B        :WT5
         LOD      :WTD
         LW,4     :WTD
         LW,4     :WTS1,4
         BAL,7    *4
         LW,7     #ODELAY
         STW,7    :WTD+1
         LW,7     #TIMEOUT
         BEZ      %+2
         MTW,1    #SEQCEF
         B        #SEQOK
*                 ERROR TABLE
:WTET    ETAB     2,:WTD,2,:H8
*                 REPORT PART
:WT5     EQU      %
         SEND     :WTET
         B        #SEQRP
*
*
**************************************************************
*        *** :PT - SUBROUTINE ***
**************************************************************
*      The :PT subroutine speads data patterns in a
*      buffer using the PAT subroutine. In the report
*      phase the pattern type, the buffer address, the
*      buffer length, and the pattern data are printed.
*      Procedure
*                  PT
*      Local Parameters
*                  None
*      Global Parameters
*      @BUF        ADDRESS OF BUFFER WORD ADDRESS
*      #BUFLEN     BUFFER LENGTH IN BYTES
*      #PTYP       PATTERN TYPE
*      @PBUF       ADDRESS OF PATTERN BUFFER ADDRESS
*      Subroutines
*                  PAT  subroutine
*                 EXECUTION PART
:PT      EQU      %
         B        :PT5
         BAL,7    PAT
         B        #SEQOK
*                 ERROR TABLE
:PTET0   ETAB     4,:D,4,:H30
:PTET1   ETAB     5,:D,5,:H31
:PTET2   ETAB     4,:D,4,:H32
:PTET3   ETAB     3,:D,3,:H33
:PTET4   ETAB     3,#PBUF,3,:H34
:PTET5   ETAB     4,#PBUF,4,:H35
:PTET6   ETAB     2,#PBUF,2,:H36
*                 REPORT PART
:PTA     EQU      %
         NOP      :PTET0
         NOP      :PTET1
         NOP      :PTET2
         NOP      :PTET3
         NOP      :PTET3
         NOP      :PTET3
:PTB     EQU      %
         DATA     0
         DATA     0
         DATA     0
         NOP      :PTET4
         NOP      :PTET5
         NOP      :PTET6
:PT5     EQU      %
         MVW      #PTYP,:D0
         MVW      @BUF,:D1
         MVW      #BUFLEN,:D2
         MVW      *@PBUF,:D3
         LW,7     *@PBUF,1
         STW,7    :D4
         LW,4     #PTYP
         LW,7     :PTA,4
         STW,7    :PT7+1
:PT7     SEND     0
         LW,7     :PTB,4
         BEZ      #SEQRP
         STW,7    :PT8+1
:PT8     SEND     0
         B        #SEQRP
*
*
**************************************************************
*        *** :SK  - SUBROUTINE ***
**************************************************************
*      The :SK subroutine executes a Seek operation, checks,
*      and saves the returned status. All execution,
*      testing, and reporting is performed with general subroutines.
*      The order code X'83' is used to generate a device interrupt.
*      The buffer for the seek address is SKADR.
*      Procedure
*                  SK
*      Local Parameters
*                  None
*                 DATA BASE
:SKD     EQU      %
         DATA     IOCDX83           IOCD WORD        ADDRESS
         DATA     X'970000E0'       SIO MASK
         DATA     X'10000000'       SIO EXPECTED STATUS/COND.CODE
         DATA     0                 SIO OBSERVED STATUS/COND.CODE
         DATA     X'FFFF00E0'       AIO MASK
         DATA     X'08000000'       AIO EXPECTED STATUS/COND.CODE
         DATA     0                 AIO OBSERVED STATUS
         DATA     X'FFFFFFFF'       AIO MASK FOR IO ADDRESS
         DATA     0                 AIO EXPECTED IO ADDRESS
         DATA     0                 AIO OBSERVED IO ADDRESS
         DATA     X'9FFF00E0'       TIO MASK
         DATA     X'10000000'       TIO EXPECTED STATUS/COND.CODE
         DATA     0                 TIO OBSERVED STATUS/COND.CODE
         DATA     X'FFFF00E0'       TDV MASK
         DATA     X'00000000'       TDV EXPECTED STATUS/COND.CODE
         DATA     0                 TDV OBSERVED STATUS/COND.CODE
         DATA     X'0000FFFF'       TDV MASK FOR BYTE COUNT
         DATA     0                 TDV EXPECTED BYTE COUNT
         DATA     0                 TDV OBSERVED BYTE COUNT
         DATA     X'FFFFFFFF'       TDV MASK FOR IOCD ADDRESS
         DATA     DA(IOCDX83)       TDV EXPECTED IOCD ADDRESS
         DATA     0                 TDV OBSERVED IOCD ADDRESS
         DATA     0                 DELAY TIME/TIME FLAG
*                 EXECUTION PART
:SK      EQU      %
         B        :SK5              BRANCH TO REPORT PART
         LW,4     =:SKD             LOAD DATA BASE ADDRESS
         BAL,7    IOEX              BRANCH TO EXECUTE SUBROUTINE
         LW,4     =:SKD             LOAD DATA BASE ADDRESS
         BAL,7    IOTEST            BRANCH TO TEST SUBROUTINE
         LW,7     #SEQCEF           CHECK ERROR FLAG
         BEZ      %+2               OK
         MTW,1    #SEQAF            SET ABORT FLAG
         B        #SEQOK            RETURN TO SEQUENCER ROUTINE
*                 ERROR TABLE
:SKET    ETAB     1,SKADR,1,:H13
*                 REPORT PART
:SK5     EQU      %
         SEND     :SKET
         LW,7     #SEQCEF
         BEZ      %+2
         B        :SK7
         B        #SEQRP
:SK7     EQU      %
         LW,4     =:SKD             LOAD DATA BASE ADDRESS
         BAL,7    IOPR              BRANCH TO PRINT SUBROUTINE
         B        #SEQRP            RETURN TO SEQUENCER ROUTINE
*
*
**************************************************************
*        *** :SN  - SUBROUTINE ***
**************************************************************
*      The :SN subroutine executes a Sense operation, checks,
*      and saves the returned status. All execution,
*      testing, and reporting is performed with general subroutines.
*      The testing and preparation for error reporting of
*      the sense data is performed in the :SN test subroutine.
*      Procedure
*                  SN
*      Local Parameters
*                  None
*      Additional Global Parameters
*      SENOBS      Observed sense data
*      SENEXP      Expected sense data
*      SENMAS      Mask for sense data
*                 DATA BASE
:SND     EQU      %
         DATA     IOCDX04           IOCD WORD        ADDRESS
         DATA     X'970000E0'       SIO MASK
         DATA     X'10000000'       SIO EXPECTED STATUS/COND.CODE
         DATA     0                 SIO OBSERVED STATUS/COND.CODE
         DATA     X'FFFF00E0'       AIO MASK
         DATA     X'00100000'       AIO EXPECTED STATUS/COND.CODE
         DATA     0                 AIO OBSERVED STATUS
         DATA     X'FFFFFFFF'       AIO MASK FOR IO ADDRESS
         DATA     0                 AIO EXPECTED IO ADDRESS
         DATA     0                 AIO OBSERVED IO ADDRESS
         DATA     X'9FFF00E0'       TIO MASK
         DATA     X'10000000'       TIO EXPECTED STATUS/COND.CODE
         DATA     0                 TIO OBSERVED STATUS/COND.CODE
         DATA     X'FFFF00E0'       TDV MASK
         DATA     X'00000000'       TDV EXPECTED STATUS/COND.CODE
         DATA     0                 TDV OBSERVED STATUS/COND.CODE
         DATA     X'0000FFFF'       TDV MASK FOR BYTE COUNT
         DATA     0                 TDV EXPECTED BYTE COUNT
         DATA     0                 TDV OBSERVED BYTE COUNT
         DATA     X'FFFFFFFF'       TDV MASK FOR IOCD ADDRESS
         DATA     DA(IOCDX04)       TDV EXPECTED IOCD ADDRESS
         DATA     0                 TDV OBSERVED IOCD ADDRESS
         DATA     0                 DELAY TIME/TIME FLAG
:SND1    RES      12
:SND2    RES      1
*                 EXECUTION PART
:SN      EQU      %
         B        :SN5              BRANCH TO REPORT PART
         LI,4     -4
         STW,0    SENOBS+4,4        RESET SENSE DATA BUFFER
         BIR,4    %-1
         LW,4     =:SND             LOAD DATA BASE ADDRESS
         BAL,7    IOEX              BRANCH TO EXECUTE SUBROUTINE
         LW,4     =:SND             LOAD DATA BASE ADDRESS
         BAL,7    IOTEST            BRANCH TO TEST SUBROUTINE
         MVW      #SEQCEF,:SND2
         LI,4     -4
:SN1     EQU      %
         LW,5     SENEXP+4,4
         AND,5    SENMAS+4,4
         LW,6     SENOBS+4,4
         AND,6    SENMAS+4,4
         LW,7     SENOBS+4,4
         STW,5    :SND1+4,4
         STW,6    :SND1+8,4
         STW,7    :SND1+12,4
         CW,5     6
         BE       %+2
         MTW,1    #SEQCEF
         BIR,4    :SN1
         B        #SEQOK            RETURN TO SEQUENCER ROUTINE
*                 ERROR TABLE
:SNET    ETAB,3   12,:SND1,4,:H14
*                 REPORT PART
:SN5     EQU      %
         LW,7     :SND2
         BEZ      :SN7
         LW,4     =:SND             LOAD DATA BASE ADDRESS
         BAL,7    IOPR              BRANCH TO PRINT SUBROUTINE
:SN7     EQU      %
         SEND     :SNET
         B        #SEQRP            RETURN TO SEQUENCER ROUTINE
*
*
**************************************************************
*        *** CLEAR BUFFER 2 - SUBROUTINE ***
**************************************************************
*        THIS TEST SUBROUTINE CLEARS BUFFER 2 WITH X'00000000'.
*        IT IS USED TO CLEAR THE BUFFER 2 BEFORE EXECUTION
*        OF A READ OPERATION.
:CB2B    RES      1
:CB2     EQU      %
         B        :CB25             BRANCH TO REPORT PART
         LW,7     #BUFLEN           GET THE LENGTH OF THE BUFFER
         AI,7     3                  AND CALCULATE THE WORD LENGTH
         SLS,7    -2
         LCW,4    7                 FORM COMPLEMENT
         AI,7     BF2               CALCULATE END OF BUFFER ADDRESS
         STW,7    :CB2B                AND SAVE IT.
         STW,0    *:CB2B,4          CLEAR BUFFER
         BIR,4    %-1               LOOP
         B        #SEQOK            RETURN
:CB2ET   ETAB     4,:D,4,:H30
:CB25    EQU      %
         STW,0    :D0               FORM REPORT MESSAGE
         MVW      =BF2,:D1
         MVW      #BUFLEN,:D2
         STW,0    :D3
         SEND     :CB2ET
         B        #SEQRP
*
*
**************************************************************
*        *** :HCOMP - SUBROUTINE ***
**************************************************************
*      THE :HCOMP SUBROUTINE COMPARES TWO BUFFERS AND PRINTS
*      the contents of these buffers in the report phase.
*      Procedure
*                  HCOMP
*      Local Parameters
*                  None
*                 EXECUTION PART
:HCOMP   EQU      %
         B        :HCOMP5
         BAL,7    HCOM
         MTW,0    #COMERR
         BEZ      #SEQOK
         B        #SEQER
:HCOMP5  BAL,7    HCOMP
         B        #SEQRP
*
*
*
**************************************************************
*        *** :HPAT - SUBROUTINE ***
**************************************************************
*        THE :HPAT SUBROUTINE BUILDS THE HEADER PATTERN
*        FOR ONE TRACK.  THE USER HAS CONTROL OVER THE ADDRESS
*        WHICH IS WRITTEN AND THE BUFFER WHICH IS USED THRU
*        PARAMETERS.
*      FLAWMARKS ARE WRITTEN ON EACH SECTOR.
*        PARAMETERS
*        SKADR    SEEK  ADDRESS BUFFER
*        @HBUF    ADDRESS OF BUFFER ADDRESS LABEL
*        SMAX     NUMBER OF SECTORS PER TRACK
*        #FLAWM   FLAW MARK FLAG
:HPAT    EQU      %
         B        #SEQRP
         LI,4     0
         LI,5     0
HPAT1    EQU      %
         LW,7     SKADR
         LW,15    #CONTX            CHECK FOR CONTROLLER TYPE
         CI,15    RMP
         BE       HPAT3
         SLS,7    -8
         MTW,0    #FLAWM
         BEZ      %+2
         AW,7     =X'FF000000'
         STW,7    *@HBUF1,4
         AI,4     1
         LW,7     5
         SCS,7    -8
         AW,7     =X'00FFFFFF'
HPAT2    RES
         STW,7    *@HBUF1,4
         AI,4     1
         AI,5     1
         CW,5     SMAX
         BL       HPAT1
         B        #SEQOK
HPAT3    RES
         MTW,0    #FLAWM
         BEZ      %+2
         AW,7     =X'80000000'
         MTW,0    #ALTM             CHECK ALT. MARK FLAG
         BEZ      %+2
         AW,7     =X'40000000'
         AW,7     5                 ADD SECTOR ADDRESS
         STW,7    *@HBUF1,4
         AI,4     1
         LW,7     KM1
         B        HPAT2
         B        #SEQOK
*
*
**************************************************************
*        *** PRINT HEADER DATA BUFFER CONTENTS ***
**************************************************************
*        THIS TEST SUBROUTINE PRINTS THE CONTENTS OF THE
*        HEADER BUFFER (@HBUF1) IN THE FORM OF 8 BYTES
*        PER LINE, THAT IS ONE HEADER PER LINE.
*        PARAMETERS
*        @HBUF1   HEADER BUFFER ADDRESS
*        #HBUFLEN  HEADER BUFFER LENGTH IN BYTES
:PHBUFL  DATA     0                 LOOP LIMIT
:PHBUFE1 ETAB     3,:D,3,:H39
:PHBUFE2 GEN,8,24 3,:D
         GEN,8,24 X'30',0
         GEN,8,24 0,:H39
*
:PHBUF   EQU      %
         B        %+2
         B        #SEQOK
         LW,6     #HBUFLEN          GET LENGTH OF BUFFER
         SLS,6    -3                  AND DIVIDE THRU 8
         STW,6    :PHBUFL              AND SAVE AS LOOP LIMIT
         LI,4     0
         LI,5     0
         LW,6     @HBUF1
:PHBUF1  EQU      %
         STW,6    :D0
         LW,7     *6
         STW,7    :D1
         AI,6     1
         LW,7     *6
         STW,7    :D2
         AI,6     1
         MTW,0    5
         BEZ      :PHBUF2
         SEND     :PHBUFE2
         B        :PHBUF3
:PHBUF2  SEND     :PHBUFE1
         AI,5     1
:PHBUF3  LOOP,4   :PHBUFL,:PHBUF1
         B        #SEQRP
*
*
*
*
**************************************************************
*        *** :IO1H - SUBROUTINE ***
**************************************************************
*
*
*
*      The :IO1H subroutine executes an I/O operation, checks,
*      and saves the returned status. All execution,
*      testing, and reporting is performed with general subroutines.
*
*      Procedure
*
*                  IO1H      IOCDX03
*
*
*      Local Parameters
*
*      1.          IOCD address
*
*
*                 DATA BASE
*
:IO1HD   EQU      %
         DATA     0                 IOCD WORD        ADDRESS
         DATA     X'970000E0'       SIO MASK
         DATA     X'10000000'       SIO EXPECTED STATUS/COND.CODE
         DATA     0                 SIO OBSERVED STATUS/COND.CODE
         DATA     X'FFFF00E0'       AIO MASK
         DATA     X'00100000'       AIO EXPECTED STATUS/COND.CODE
         DATA     0                 AIO OBSERVED STATUS
         DATA     X'FFFFFFFF'       AIO MASK FOR IO ADDRESS
         DATA     0                 AIO EXPECTED IO ADDRESS
         DATA     0                 AIO OBSERVED IO ADDRESS
         DATA     X'9FFF00E0'       TIO MASK
         DATA     X'10000000'       TIO EXPECTED STATUS/COND.CODE
         DATA     0                 TIO OBSERVED STATUS/COND.CODE
         DATA     X'BFFF00E0'       TDV MASK
         DATA     X'00000000'       TDV EXPECTED STATUS/COND.CODE
         DATA     0                 TDV OBSERVED STATUS/COND.CODE
         DATA     X'0000FFFF'       TDV MASK FOR BYTE COUNT
         DATA     0                 TDV EXPECTED BYTE COUNT
         DATA     0                 TDV OBSERVED BYTE COUNT
         DATA     X'FFFFFFFF'       TDV MASK FOR IOCD ADDRESS
         DATA     0                 TDV EXPECTED IOCD ADDRESS
         DATA     0                 TDV OBSERVED IOCD ADDRESS
         DATA     0                 DELAY TIME/TIME FLAG
*
*                 EXECUTION PART
*
:IO1H    EQU      %
         B        :IO1H5            BRANCH TO REPORT PART
         LOD      :IO1HD            LOAD PARAMETERS
         LW,6     :IO1HD
         SLS,6    -1                FORM DOUBLE WORD ADDRESS
         STW,6    :IO1HD+20           AND STORE IT.
         LW,4     =:IO1HD           LOAD DATA BASE ADDRESS
         BAL,7    IOEX              BRANCH TO EXECUTE SUBROUTINE
         LW,4     =:IO1HD           LOAD DATA BASE ADDRESS
         BAL,7    IOTEST            BRANCH TO TEST SUBROUTINE
         B        #SEQOK            RETURN TO SEQUENCER ROUTINE
*
*                 REPORT PART
*
:IO1H5   EQU      %
         LW,4     =:IO1HD           LOAD DATA BASE ADDRESS
         BAL,7    IOPR              BRANCH TO PRINT SUBROUTINE
         B        #SEQRP            RETURN TO SEQUENCER ROUTINE
*
*
***************************************************************
*        *** COMMON UTILITY SUBTEST CONTROL ROUTINE ***
***************************************************************
*
*        CALLING SEQUENCES:
*
*        BAL,15   CUR:CYL           CYLINDER OPERATIONS
*        DATA     XMWRF
*
*        BAL,15   CUR:TR            TRACK OPERATIONS
*        DATA     XMHWR
*
*        BAL,15   CUR:SEC           SECTOR OPERATIONS
*        DATA     XMWRS
*
*        PARAMETERS:
*                 #SFIRST           FIRST ADDRESS (SECTOR FORM)
*                 #SKADR            START SEEK ADDRESS
*                 #RETRY            RETRY COUNT
*                 #INH:P            INHIBIT PRINTOUT
*
*
*
CURS     RES      12                RETURN
CURX     RES      1                 OPERATION TYPE
CURXR    RES      1                 INDEX FOR RECOVERY
*
CURT     DATA     0                 TDV STATUS
CURTDV   LW,7     :IO4BD+15         GET TDV STATUS FROM DATA BASE
         LI,7     0
         LW,7     :IO1D+15
*
CURIS    STH,0    SKADR,1           INITIALIZE SEEK ADDRESS
         STB,0    SKADR,3
         NOP
*
CURINC   BAL,15   INCC              INCREMENT SEEK ADDRESS
         BAL,15   INCT
         BAL,15   INCS
*
CURAR    DATA     INCS,EVEN,DECS
*
CUR:CYL  EQU      %                 CYLINDER OPERATION
         STW,0    CURX
         B        CUR
*
CUR:TR   EQU      %                 TRACK OPERATION
         STW,1    CURX
         B        CUR
*
CUR:SEC  EQU      %                 SECTOR OPERATION
         STW,2    CURX
         B        CUR
*
CURM TEXTCS 'RETRY COUNT EXHAUSTED: ROUTINE ABORTED',CR
*
CUR      EQU      %
         LCI      12                SAVE ALL REGISTERS
         STM,4    CURS
         MVW      *15,CURTEST+1     PREP. TEST EXECUTION
         STW,1    #SEQINH           SET PRINT INHIBIT
         MVW      #SFIRST,#SCNT     INITIALIZE SECTOR COUNT
         MVW      #SKADR,SKADR        AND SEEK ADDRESS
CUR0     EQU      %
         LW,7     CURX              CHECK IF SEEK ADDRESS CORRECT
         EXU      CURIS,7           PREP. SEEK ADDRESS
*
CUR1     EQU      %
         LCW,7    RETRY             PREPARE RETRY COUNT
         AI,7     -1
         STW,7    #RCNT
CUR2     EQU      %
*
CURTEST  TEST     0                 EXECUTE TEST MODULE
*
*
         MTW,0    #TRACE            CHECK DISPLAY MODE
         BNEZ     CUR34             YES: REPORT
         LW,7     #SEQEF            CHECK ERROR FLAG
         BEZ      CUR5              NO: CONTINUE
         LW,7     CURX              GET OP. TYPE
         EXU      CURTDV,7          GET TDV STATUS
         STW,7    CURT
         MTW,0    #CONTX            CHECK CONTROLLER TYPE
         BNEZ     %+3
         AND,7    =X'BBFE00C0'      RDC ONLY
         B        %+2
         AND,7    =X'BFFE00C0'      ALL ERRORS EXCEPT FLAW MARK
         BNEZ     CUR32             YES: REPORT
         LW,7     CURT              GET TDV STATUS
         AND,7    =X'40000000'      FLAW MARK
         BNEZ     CUR48             YES: GO TO FLAW MARK SEEK ADR. HANDLER
CUR32    EQU      %
         MTW,0    #INH:P            CHECK PRINT INHIBIT
         BNEZ     %+3               SKIP PRINTOUT
CUR34    RES
         STW,0    #SEQINH           RESET PRINT INHIBIT
         BAL,7    #SEQR             REPORT ERROR
         STW,1    #SEQINH           SET PRINT INHIBIT
         MTW,0    #SEQEF            CHECK ERROR FLAG
         BEZ      CUR5              NO: CONTINUE
         LW,7     CURT              CHECK TDV STATUS
         AND,7    =X'40000000'      NO FLAWMARK: NORMAL ERROR
         BNEZ     CUR48
*
CUR4     EQU      %
         MTW,0    RETRY             CHECK RETRY FOR ZERO
         BEZ      CUR44             YES: CONTINUATION REQUESTED
         MTW,1    #RCNT             INCR. RETRY COUNT
         LW,7     #RCNT             NO CHECK RETRY COUNT
         BL       CUR40             ISSUE RESTORE, THEN RETRY
         LI,R6    CURM              SEND ABORT MSG
         BAL,R7   TY:M
         B        CUR9
CUR40    RES
         MTW,0    #CONTX            CHECK FOR RDC
         BEZ      CUR42
         TEST     XM02
         B        CUR2
CUR42    TEST     XM02RDC
         B        CUR2
CUR44    EQU      %                 RECOVERY FOR FAST TESTS
         MTW,0    CURX              CHECK OPERATION TYPE
         BNEZ     CUR5              GO ON WITH SKADR INCREMENT
         LW,7     SENOBS
         AND,7    =X'7FFFFFFF'
         STW,7    SKADR
         STW,0    CURXR             RESET RECOVERY INDEX
         LW,7     #CONTX            CHECK CONTROLLER TYPE
         CI,7     RMP
         BE       CUR46
*
         LW,7     CURT              GET TDV STATUS
         AND,7    =X'08600000'      CHECK FOR TRANSMISSION ERROR
         BEZ      %+2               NO
CUR46    RES
         MTW,1    CURXR             ELSE: INCR.
         LW,4     CURXR             LOAD AS INDEX
         LW,7     CURAR,4            GET RECOVERY ADDRESS
         BAL,R15  *7                   AND GO TO ADDRESS PREPARARTION
         MTW,0    INCEND
         BNEZ     CUR9              RETURN
         B        CUR1               ELSE TO NORMAL ENTRANCE
*
*
CUR48    EQU      %
         LW,7     SENOBS
         AND,7    =X'7FFFFFFF'
         STW,7    SKADR
         BAL,15   INCS
         MTW,0    INCEND
         BNEZ     CUR9              RETURN
         B        CUR1               ELSE TO NORMAL ENTRANCE
*
CUR5     EQU      %                 CONTINUATION ROUTINE
         LW,4     CURX
         EXU      CURINC,4          INCR. SEEK ADDRESS
         MTW,0    INCEND            CHECK IF SUFACE END
         BEZ      CUR0              ELSE CONTINUE
*
CUR9     EQU      %                 RETURN
         LCI      12                RESTORE ALL REGISTERS
         LM,4     CURS
         B        *15,1
*
*
***************************************************************
*        *** SEEK ADDRESS EVEN CHECK SUBROUTINE ***
***************************************************************
*
EVEN     EQU      %                 SEEK ADDRESS IS NOT CHANGED
         STW,0    INCEND            CHECK FOR INVALID
         LB,7     SKADR,3             SEEK ADDRESS
         CW,7     SMAX
         BL       %+2
         B        EVEN8
         LB,7     SKADR,2
         CW,7     TMAX
         BL       *15
EVEN8    MTW,1    INCEND
         B        *15               RETURN
*
*
***************************************************************
*        *** SEEK ADDRESS DECREMENT SUBROUTINE ***
***************************************************************
*
DECS     EQU      %                 SEEK ADDRESS IS DECREMENTED
         STW,0    INCEND
         MTW,-1   #SCNT
         LB,7     SKADR,3
         BEZ      DECS2
         SW,7     K1
         STB,7    SKADR,3
         B        *15
DECS2    EQU      %
         LW,7     SLAST
         STB,7    SKADR,3
         LB,7     SKADR,2
         BEZ      DECS6
         SW,7     K1
         STB,7    SKADR,2
         B        *15               RETURN
DECS6    BAL,7    PERROR
*
*
***************************************************************
*        *** SEEK ADDRESS INCREMENT SUBROUTINE ***
***************************************************************
*
* THIS SUBROUTINE INCREMENTS THE SEEK ADDRESS (SKADR) AND
* THE ABSOLUTE SECTOR ADDRESS (#SCNT).
*
*        PARAMETERS:
*                 #SCNT             SECTOR COUNT
*                 SKADR             SEEK ADDRESS
*                 #SLAST            LAST SECTOR/PACK
*                 INCEND            INCREMENT END FLAG
*                 SMAX              SECTORS/TRACK
*                 TMAX              TRACKS/CYLINDER
*                 CMAX              CYLINDERS/PACK
*
*
INCEND   DATA     0                 END OF SURFACE FLAG
WVTOCWRT DATA     0                 WVTOC WRITE FLAG--MEANS LOGICAL
*   SECTOR INCREMENT, NOT PHYSICAL FOR 7275.
*
INCS     EQU      %
         STW,0    INCEND
         LW,7     #SCNT             ADD ONE
         AI,7     1                 STORE
         STW,7    #SCNT             AND CHECK IF LAST SECTOR
         CW,7     #SLAST            YES: END OF SURFACE
         BG       INC8              ELSE INCR. SECTOR ADDRESS
INCS1    EQU      %
         STW,0    INCEND
         MTW,1    SKADR
         LB,7     SKADR,2           GET TRACK ADDRESS
         CW,7     TMAX               AND COMPARE WITH LIMIT
         BGE      INCC1             OK: GO INCR. CYLINDER
         LB,7     SKADR,3
         CW,7     SMAX
         BGE      INCT1             INCREMENT TRACK.
*
*   IF THE WVTOC WRITE FLAG IS SET, IGNORE THE LAST SECTOR
*   OF 7275.
*
         LW,R7    WVTOCWRT          GET DEVX FLAG.
         AH,R7    SKADR,1           GET TRACK/SECTOR.
         CI,R7    X'3120A'          LAST SECTOR OF 7275 CYL?
         BNE      INC9              IF SO,
         B        INCS1               IGNORE IT.
INCT     EQU      %
         STW,0    INCEND
         LW,7     #SCNT             ADD ONE
         AW,7     SMAX
         STW,7    #SCNT             AND CHECK IF LAST SECTOR
         CW,7     #SLAST            YES: END OF SURFACE
         BG       INC8              ELSE INCR. SECTOR ADDRESS
INCT1    EQU      %
         STW,0    INCEND
         STB,0    SKADR,3
         MTB,1    SKADR,2
         LB,7     SKADR,2
         CW,7     TMAX
         BL       INC9
         B        INCC1
INCC     EQU      %
         STW,0    INCEND
         LW,7     #SCNT             ADD ONE
         AW,7     STMAX
         STW,7    #SCNT             AND CHECK IF LAST SECTOR
         CW,7     #SLAST            YES: END OF SURFACE
         BG       INC8              ELSE INCR. SECTOR ADDRESS
INCC1    EQU      %
         STW,0    INCEND
         STH,0    SKADR,1
         MTH,1    SKADR
         LH,7     SKADR
         CW,7     CMAX
         BL       INC9
INC8     MTW,1    INCEND
INC9     B        *15
*
*
*
***************************************************************
*        *** HEADER FORMATING AND WRITING ***
***************************************************************
*
* THIS ROUTINE FORMATS THE HEADER, WRITES THE HEADER AND VERIFIES
* THE HEADER. DEPENDING FROM THE CONTROLLER TYPE THIS ROUTINE WRITES
* THE HEADER OF A TRACK (RDC), A PAIR OF TRACKS (RMC), OR OF A SECTOR
* (RMP).
* PARAMETERS:
*        SKADR    SECTOR ADDRESS OF BAD SECTOR (RMP), OR FIRST SECTOR
*                 ADDRESS OF TRACK (RDC) OR PAIR OF TRACKS (RMC)
*        ASKADR   ALTERNATE SECTOR ADDRESS( RMP), OR FIRST SECTOR
*                 ADDRESS OF ALTERNATE TRACK (TRACK PAIR)
*        #FLAWM   FLAWMARK INDICATOR
*        #ALTM    ALTERNATE MARK INDICATOR
*
HFWR:S   RES      5
*
HFWR     EQU      %
         LCI      4                 SAVE REG. 4 THRU  REG. 8
         STM,4    HFWR:S+1
         LW,6     SKADR             SAVE SKADR
         STW,6    HFWR:S
         LW,7     #CONTX            CHECK CONTOLLER TYPE
         CI,7     RMP
         BE       HMOD
         SLS,6    -8                SHIFT RIGHT
         MTW,0    #FLAWM            CHECK IF FLAWMARK REQUESTED
         BEZ      %+2               NO: SKIP ADDING OF FLAW MARK
         AW,6     =X'FF000000'      ADD FLAWMARK
         LW,7     ASKADR
         MTB,0    ASKADR            CHECK FOR MOST SIGN. BIT OF CYL.ADR
         BEZ      %+2               NO
         OR,7     =X'8000'          SET BIT FOR MOST SIGN. BIT OF CYL
         MTW,0    #ALTM             CHECK IF ALTENATE ADR. REQUESTED
         BNEZ     %+2               YES: KEEP REG. 7
         LW,7     =X'FFFFFF'        ELSE GET X'FFFFFF'
*
         LI,5     0                 RESET SECTOR INDEX
         LW,4     @HBUF1            GET BUFFER ADDRESS
HFWR4    EQU      %
         STB,5    7                 STORE SECTOR ADDRESS
         STW,6    0,4               STORE FIRST WORD OF HEADER
         STW,7    1,4                 AND SECOND WORD OF HEADER
         AI,4     2                 INC. BUFFER ADDRESS
         AI,5     1                 INC. SECTOR INDEX
         CW,5     SMAX              CHECK FOR LIMIT
         BL       HFWR4             NO: LOOP
*
         LW,8     HBUFLEN
         STW,8    #HBUFLEN
         STH,8    IOCDX09+3,1                                          #29040
         STH,8    IOCDX0A+1,1
         MTW,0    #CONTX            CHECK FOR CONTROLLER TYPE
         BEZ      HFWR8             TERMINATE
         LW,15    #DEVX             GET DEVICE TYPE INDEX
         CI,15    #7275             CHECK FOR 7275
         BNE      HFWR5
         CB,6     =18,3
         BE       HFWR8
HFWR5    EQU      %
         AI,6     1
         MTW,0    #ALTM             CHECK ALTERNATE FLAG
         BEZ      %+2               NOT SET: KEEP X'FFFFFF'
         AI,7     X'100'
         LI,5     0
HFWR6    EQU      %
         STB,5    7                 STORE SECTOR ADDRESS
         STW,6    0,4               STORE FIRST WORD OF HEADER
         STW,7    1,4                 AND SECOND WORD OF HEADER
         AI,4     2                 INC. BUFFER ADDRESS
         AI,5     1                 INC. SECTOR INDEX
         CW,5     SMAX              CHECK FOR LIMIT
         BL       HFWR6
*
         LW,8     HBUFLEN
         SLS,8    1
         STW,8    #HBUFLEN
         STH,8    IOCDX09+3,1                                          #29040
         STH,8    IOCDX0A+1,1
HFWR8    EQU      %
*
         STW,0    #FLAWM            RESET FLAWMARK FLAG
         STW,0    #ALTM               AND ALTERNATE ADDRESS FLAG
         TEST     XMHWR1            WRITE HEADERS
         TEST     XMHRD2              THEN READ AND VERIFY
HFWR9    RES
         LW,7     HFWR:S            RESTORE SEEK ADDRESS
         STW,7    SKADR               AND REGISTERS
         LCI      4
         LM,4     HFWR:S+1
         B        *7
*
***************************************************************
*        *** MODIFY HEADER WRITE SUBROUTINE ***
***************************************************************
*
HMOD     EQU      %
         AND,6    =X'FFFFFF00'      MODIFY SEEK ADDRESS
         STW,6    SKADR              FOR HEADER WRITE OPERATION
         TEST     XMHRD1            READ ALL HEADERS OF TRACK
         LW,7     HFWR:S            CALCULATE
         AND,7    KX00FF              THE BUFFER LOCATION
         AW,7     7                     OF THE SECTOR WHICH SHALL
         AW,7     @HBUF1                  BE MODIFIED AND MODIFY
         LW,6     0,7               GET 1 WORD OF HEADER
         AND,6    =X'3FFFFFFF'       AND MASK OUT POSSIBLE BITS
         MTW,0    #FLAWM            CHECK FLAWMARK FLAG
         BEZ      HMOD2
         AW,6     =X'80000000'      YES: ADD FLAW MARK BIT
         STW,6    0,7
         B        HMOD3
HMOD2    RES
         MTW,0    #ALTM             CHECK ALTERNATE MARK
         BEZ      HMOD3             NO
         AW,6     =X'40000000'      YES: ADD ALT. MARK BIT
         STW,6    0,7
HMOD3    RES
         MTW,0    #ALTM
         BEZ      HMOD4
         LW,6     ASKADR            GET ALTERNATE SECTOR ADDRESS
         STW,6    1,7                 AND STORE
HMOD4    RES
         STW,0    #FLAWM            RESET FLAWMARK FLAG
         STW,0    #ALTM             RESET ALTERNATE MARK FLAG
         TEST     XMHWR1            REWRITE HEADERS OF SPECIFIED TRACK
         TEST     XMHRD             READ AND VERIFY
         B        HFWR9
*
*
***************************************************************
* ADRCHK - SEEK ADDRESS CHECK FOR CORRECTNESS
***************************************************************
*
ADRCHK   RES
         LH,14    R10               GET CYLINDER ADDRESS
         CW,14    ACYL                AND COMPARE WITH ALTERN. AREA LIM.
         BGE      *R15              ERROR
         LB,14    R10,2             GET TRACK ADDRESS
         CW,14    TMAX
         BGE      *R15              ERROR
         LB,14    R10,3             GET SECTOR ADDRESS
         CW,14    SMAX
         BGE      *R15              ERROR
         B        *R15,1
*
*
*
*
*
         PAGE
***************************************************************
***************************************************************
***                                                         ***
***                                                         ***
*** CONTROL ROUTINES                                        ***
***                                                         ***
***                                                         ***
***************************************************************
***************************************************************
*
*
*
*        *** CONFIGURATION ROUTINE ***
*        *****************************
*
#CONFIG  EQU      %
         LI,4     #UNLISTS          GET UNIT LIST NUMBER
         CW,7     #UNLISTE,4         CHECK MODEL NUMBER
         BE       #CONFIG6          OK
         AI,4     1
         BIR,4    %-3               LOOP
         LW,14    15                SAVE REG.15
         BAL,15   *#REPORT
         NOP      #ABORTM1
         LW,15    14                RESTORE REG. 15
#CONFIG4 MTW,1    15
         B        #CONFIG9
*
#CONFIG6 RES
         LW,7     #UNLISTE+1,4      PICK UP MODEL MAP
         STW,7    #UNM               AND STORE IT IN #UNM
         LB,4     #UNM
         STW,4    #DEVX             SAVE DEVICE TYPE INDEX
         LW,7     DTYP,4            GET DEVICE TYPE
         STW,7    #CONTX            SAVE CONTROLLER TYPE INDEX
         LW,7     CNUM,4            GET MAX. CYLINDER NUMBER
         STW,7    CMAX                AND SAVE....
         AI,7     -1                     .....
         STW,7    CLAST
         LW,7     TNUM,4            GET MAX. NUMBER OF TRACKS...
         STW,7    TMAX
         AI,7     -1
         STW,7    TLAST
         LW,7     SNUM,4            GET MAX. NUMBER OF SECTORS....
         STW,7    SMAX
         AI,7     -1
         STW,7    SLAST
         LW,7     ACNUM,4           GET ALTERNATE CYLINDER START
         STW,7    ACYL
         SLS,7    16                SHIFT TO FORM VALID SEEK ADDRESSS
         STW,7    #ALTSK               AND SAVE
         LW,7     SMAX              GET SECTORS/TRACK
         MW,7     TMAX               AND MULTIPLY WITH TRACKS/CYL
         STW,7    STMAX                AND SAVE AS SECTORS/CYL
         LW,7     CLAST             GET LAST CYLINDER
         SLS,7    8                 SHIFT
         AW,7     TLAST
         SLS,7    8
         STW,7    LTRACK            SAVE AS LAST TRACK
#CONFIG9 EQU      %
         B        *15               RETURN
*
#ABORTM1 EQU      %
         TEXTS    CR,'VOLINIT CANNOT HANDLE THIS MODEL',EM
*
*
*
***************************************************************
***************************************************************
*
*
#START   RES
         LI,R0    1
         STW,R0   TMIT              RESET TM ITERATION COUNTER
         LI,R0    0
         STW,R0   TMERR             RESET TM ERROR COUNTER
#START2  BAL,R15  CAL               CHECK INPUT
         NOP
         NOP
         LW,R8    UA
         STW,8    #DEVADR           DEVICE ADDRESS
         LW,12    #PC               GET PRINT CONTROL
         AND,12   =8                  AND MASK OUT TRACE CONTROL BIT
         STW,12   #TRACE            TRACE PRINT FLAG
         LW,R4    TMI
         CW,R4    TMFIRST           TMFIRST=<TMI<=TMLAST
         BGE      #START4           YES-ACTIVATE TMI
         LW,R4    TMFIRST           PUT TMFIRST
         STW,R4   TMI               INTO TMI
#START4  RES
         LI,R0    0
         LI,R1    1
         LI,R2    2
         LI,R3    3
*
*
*
**************************************************************
**************************************************************
*
*
#INIT    EQU      %
         LI,15    X'C0'             LOAD MASK FOR SIGMA 5,6,7
         LW,7     #MTYPE            CHECK MACHINE TYPE
         CI,7     7                   FOR SIGMA 5-7 OR SIGMA 8-9
         BLE      #INIT10
         LI,15    X'E0'             LOAD MASK FOR SIGMA 8,9,560
         CI,7     9
         BLE      #INIT10
         LI,15    X'F0'
#INIT10  EQU      %
         STW,15   #CCMASK            AND STORE IN MASK LOC.
         STW,R0   #TMERROR          RESET ERROR COUNT
         STW,0    #SEQINH
         STW,0    #SEQTERM
         STW,0    #SEQCNT
         STW,0    SKADR             RESET SEEK ADDRESS
         STW,0    ASKADR
         STW,0    #PCNT                   PASS COUNT
         STW,0    TMODB                   TEST MODE BUFFER
         STW,0    #DBMF                   DATA BASE MODIFIER FLAG
         STW,0    #TMF              RESET TESTMODE FLAG
         STW,0    #FLAWM
         STW,0    #ALTM             RESET ALTERNATE MARK
         LI,4     -4                RESET
         STW,0    BF2+4,4             PART OF BUFFER 2
         STW,0    SENEXP+4,4
         STW,0    SENMAS+4,4          SENSE MASK
         STW,0    SENOBS+4,4          SENSE OBSERVED
         BIR,4    %-4
         LW,7     K8
         MW,7     SMAX
         STW,7    HBUFLEN           HEADER BUFFER LENGTH IN BYTES
         STW,7    #HBUFLEN
         STH,7    IOCDX09+3,1                                          #29040
         STH,7    IOCDX0A+1,1
         STH,7    IOCDX0A1+1,1
         MVW      =2000,#DELAY      SET DELAY TO 2000 MILLISEC.
         MVW      #RETRY,RETRY      SET RETRY VALUE
         STW,1    #COMLIM           SET COMPARE LIMIT FLAG TO 1
         MTW,0    #TRACE               BUT FOR TRACE MODE
         BEZ      %+2                      SET IT TO 0, IN ORDER
         STW,0    #COMLIM                   TO PRINT ALL DATA
         MVW      =X'00FFFFFF',HMASK
         MVW      =X'FF000000',HMASK+1
         MVW      =#PBUF,@PBUF      LOAD PATTERN ADDRESS FOR PAT
*
* DEVICE CONTROLLER DEPENDENT INITIALIZATION
*
#INIT2   RES
         MTW,0    #CONTX            CHECK CONTROLLER TYPE
         BNEZ     #INIT21
*
         LW,7     =X'FBFF00E0'      GET MASK FOR AIO AND TDV STATUS
         STW,7    :IO1D+4
         STW,7    :IO4BD+4
         STW,7    :IO5D+4
         STW,7    :SKD+4
         STW,7    :SND+4
         STW,7    :IO1HD+4
*
         STW,7    :IO1D+13
         STW,7    :IO4BD+13
         STW,7    :IO5D+13
         STW,7    :SKD+13
         STW,7    :SND+13
         LW,7     =X'BBFF00E0'
         STW,7    :IO1HD+13
*
         LI,7     10                GET BYTECOUNT FOR RDC SENSE
         STH,7    IOCDX04+1,1         AND STORE IT IN IOCD
*
         MVW      =X'FC000000',SENMAS+2
*
         B        #INIT25
*
#INIT21  RES
         LW,7     #CONTX            CHECK FOR CONTROLLER
         CI,7     RMC
         BNE      #INIT22
*
         MVW      =X'FF',SENMAS+1
         MVW      =X'F7FF0000',SENMAS+2
*
         B        #INIT25
*
#INIT22  RES
         LW,7     #CONTX
         CI,7     RMP
         BNE      #INIT25
*
         MVW      =X'3FFFFFFF',HMASK
         STW,0    HMASK+1
*
         MVW      =X'DF',SENMAS+1
         MVW      =X'FFFFDF00',SENMAS+2
*
         LI,7     X'81'             WRITE ORDER WITHOUT RETRY
         STB,7    IOCDWRF
         STB,7    IOCDWRS
         LI,7     X'D2'             READ ORDER WITHOUT ERROR CORRECTION
         STB,7    IOCDRDF             AND RETRY
         STB,7    IOCDRDS
         LI,7     X'85'             CHECK WRITE ORDER WITHOUT RETRY
         STB,7    IOCDCWF
         STB,7    IOCDCWS
*
         LW,7     =X'00080040'      GET EXPECTED AIO STATUS FOR RMP
         STW,7    XMWRFIO+2          AND STORE IT IN FAST OPERATION
         STW,7    XMRDFIO+2           EXPECTED AIO STATUS
         STW,7    XMCWFIO+2
         STW,7    XRDOIO+2
*
         B        #INIT25
*
#INIT25  RES
         STW,0    #INH:P            RESET PRINT INHIBIT
         LI,4     0                 TRSANSFER
#INIT30  EQU      %
         BAL,7    RAND
         LW,15    CMAX              LOAD AMMOUNT OF CYLINDERS
         MW,15    TMAX               AND MULTIPLY WITH TRACKS/CYL.
         MW,15    SMAX                 AND MULTIPLY WITH SECTORS/TRACK
         STW,15   #SMAX                 IS THE AMMOUNT OF SECTORS
         MVW      #POS,#SKADR
         LH,15    #POS
         MW,15    STMAX             CALCULATE THE NUMBER
         LB,13    #POS,2              OF THE FIRST SECTOR
         MW,13    SMAX                 COUNTED IN SECTORS
         LB,14    #POS,3
         AW,15    14
         AW,15    13
         STW,15   #SFIRST                AND SAVE IT.
         MTW,0    #POS1             CHECK #POS1 FOR ZERO
         BEZ      #INIT32           YES: USE #POS2 AS INCREMENT
         LH,15    #POS1             CALCULATE THE NUMBER
         MW,15    STMAX                OF THE LAST SELECTED SECTOR
         LB,13    #POS1,2                 COUNTED IN SECTORS.
         MW,13    SMAX
         LB,14    #POS1,3
         AW,15    14
         AW,15    13
         STW,15   #SLAST                 AND SAVE IT.
         CW,15    #SFIRST           CHECK FOR CONSISTENCY:
         BL       #INIT34           LAST<FIRST: ERROR
         CW,15    #SMAX             LAST>=LAST PHYSICAL: ERROR
         BGE      #INIT34
         B        #INIT4
*
#INIT32  EQU      %
         MTW,0    #POS2
         BEZ      #INIT33
         LW,15    #POS2
         AI,15    -1
         AW,15    #SFIRST
         STW,15   #SLAST
         CW,15    #SMAX
         BGE      #INIT34
         B        #INIT4
*
#INIT33  EQU      %
         LW,15    #SMAX             GET LAST PHYSICAL SECTOR NUMBER
         SW,15    K1                  AND SAVE IT AS LAST SELECTED SECTOR
         STW,15   #SLAST                NUMBER.
         B        #INIT4
*
*
*
#INIT34  BAL,7    PERROR
*
*
*
#INIT4   EQU      %
         TEST     XTIO:A            ANALYSE DEVICE WITH TIO
         TEST     XSEN:A            ANALYSE DEVICE WITH SENSE
         MTW,0    #CONTX            CHECK FOR RDC
         BNEZ     #INIT42           NO: BRANCH
         TEST     XM02RDC
         B        #INIT43
#INIT42  EQU      %
         TEST     XM02              ISSUE HIO AND RESTORE
#INIT43  EQU      %
         LI,4     0
         LI,5     0
         LI,6     0
         B        #EXEC
*
*
**************************************************************
**************************************************************
*
#EXEC    EQU      %
         LW,R7    TMI               GET CURRENT ROUTINE INDEX
         CI,R7    RMAX              CHECK TO BE SAVE
         BL       #EXEC1,R7
#EXEC1   RES
         B        #SKIP
         B        UT01
         B        UT02
         B        UT03
         B        UT04
         B        #SKIP
         B        UT06
         B        UT07
         B        UT08
         B        UT09
         B        #SKIP
         B        UT11
         B        UT12
         B        #SKIP
         B        UT14
         B        UT15
         B        UT16
         B        UT17
         B        UT18
         B        UT19
         B        UT20
         B        #SKIP
         B        #SKIP
         B        #SKIP
         B        UT24
         B        #SKIP
         B        UT26
         B        UT27
         B        UT28
RMAX     DATA     %-#EXEC1-1
*
*                                   TMC RETURNS TO #EXIT
*
**************************************************************
**************************************************************
*
*
*
*
*
#EXIT    EQU      %
         LI,4     -4                INITIALIZE SENSE DATA
         STW,0    SENEXP+4,4
         STW,0    SENMAS+4,4
         BIR,4    %-2
         TEST     XM04
*                                     REQUIRED
*
***************************************************************
***************************************************************
*
#DONE    RES
         MTW,1    TMEXEC            INC TM ITERATION COUNTER
#SKIP    RES
         MTW,1    TMIT              BUMP TM'S EXECUTED COUNTER
         LW,R0    #RC               GET RUN CONTROL
         CI,R0    2                   CHECK FOR LOOPING
         BGE      #START2           YES: LOOP
         LW,R0    TMIT
         CW,R0    TMITO             LAST ITERATION
         BLE      #START2           NO
         MTW,1    TMI               INC TM COUNTER
         LW,R0    TMI
         CW,R0    TMLAST
         BG       FDPEND
         B        #START
*
#END     RES
         B        INIT4
*
*
         PAGE
***************************************************************
***************************************************************
***                                                         ***
***                                                         ***
*** TEST ROUTINES                                           ***
***                                                         ***
***                                                         ***
***************************************************************
***************************************************************
**
*
*
*
**************************************************************
* Fast  Surface ROUTINE    (U,1)                             *
**************************************************************
*
*
UT01     EQU      %
         MTW,1    #PCNT
         BAL,15   CUR:CYL
         DATA     XMWRF
         MTW,1    #PCNT
         BAL,15   CUR:CYL
         DATA     XMRDF
         B        #EXIT
*
*
*
**************************************************************
* FAST VERIFY ROUTINE          (U,2)                         *
**************************************************************
*
*
UT02     EQU      %
         BAL,15   CUR:CYL
         DATA     XMCWF
         B        #EXIT
*
*
*
**************************************************************
* Fast  Write ROUTINE     (U,3)                              *
**************************************************************
*
*
UT03     EQU      %
         BAL,15   CUR:CYL
         DATA     XMWRF
         B        #EXIT
*
*
*
**************************************************************
* Fast  Read ROUTINE    (U,4)                                *
**************************************************************
*
*
UT04     EQU      %
         BAL,15   CUR:CYL
         DATA     XMRDF
         B        #EXIT
*
*
*
**************************************************************
* Slow  Surface ROUTINE    (U,6)                             *
**************************************************************
*
*
UT06     EQU      %
         MTW,1    #PCNT
         BAL,15   CUR:SEC
         DATA     XMWRS
         MTW,1    #PCNT
         BAL,15   CUR:SEC
         DATA     XMRDS
         B        #EXIT
*
*
*
**************************************************************
* Slow  VERIFY      ROUTINE    (U,7)                         *
**************************************************************
*
*
*
UT07     EQU      %
         BAL,15   CUR:SEC
         DATA     XMCWS
         B        #EXIT
*
*
**************************************************************
* Slow  Write ROUTINE     (U,8)                              *
**************************************************************
*
*
UT08     EQU      %
         BAL,15   CUR:SEC
         DATA     XMWRS
         B        #EXIT
*
*
*
**************************************************************
* Slow  Read ROUTINE    (U,9)                                *
**************************************************************
*
*
UT09     EQU      %
         BAL,15   CUR:SEC
         DATA     XMRDS
         B        #EXIT
*
*
*
**************************************************************
* Header  ROUTINE    (U,B)                                   *
**************************************************************
*
*
UT11     EQU      %
         MTW,1    #PCNT
         BAL,15   CUR:TR
         DATA     XMHWR
         MTW,1    #PCNT
         BAL,15   CUR:TR
         DATA     XMHRD
         B        #EXIT
*
*
*
*
**************************************************************
* Header  Write ROUTINE    (U,C)                             *
**************************************************************
*
*
UT12     EQU      %
         BAL,15   CUR:TR
         DATA     XMHWR
         B        #EXIT
*
*
*
*
*
*
*
**************************************************************
* Header  Read ROUTINE    (U,E)                              *
**************************************************************
*
*
UT14     EQU      %
         BAL,15   CUR:TR
         DATA     XMHRD
         B        #EXIT
*
*
*
*
**************************************************************
* Volume Initialization ROUTINE    (U,F)                     *
**************************************************************
*
*
*
*
UT15SM   DATA     X'3FFFFF00',X'3FFFFE00',X'3FFFFFFF'
UT15AF   DATA     0                 ABORT FLAG
UT15SK   DATA     0
UT15P    DATA     0                 ADDRESS POINTER
UT15PM   DATA     0                 ADDRESS POINTER FOR MODIFY HWR
UT15BC   DATA     0
*
UT15ET   DATA     BF3
         GEN,8,24 X'40',0
         DATA     :HU15
*
UT15X    RES      1                 WRITE/READ LOOP COUNT INDEX
UT15XL   DATA     3                 LOOP LIMIT
*
UT15PTYP DATA     3,3,3             PATTERN TYPE
UT15PAT0 DATA     X'DB6DB6DB',X'B6DB6DB6',X'6DB6DB6D'
UT15PAT1 DATA     X'6DB6DB6D',X'DB6DB6DB',X'B6DB6DB6'
UT15PAT2 DATA     X'B6DB6DB6',X'6DB6DB6D',X'DB6DB6DB'
*
*
UT15     EQU      %
         MVW      #HBUFLEN,UT15BC   SAVE HEADER LENGTH
         STW,0    UT15AF
         STW,0    #SKADR              START SEEK ADDRESS
         STW,0    #SFIRST           RESET ADDRESS OF FIRST SECTOR
         LW,7     #SMAX             CALCULATE
         AI,7     -1
         STW,7    #SLAST                LAST SECTOR (IN SECTORS)
         MTW,1    #PCNT
         BAL,15   CUR:TR
         DATA     XMHWR
         MVW      K0,UT15X          RESET PASS INDEX
         LW,7     K0                CLEAR
         LW,4     =-512               THE BUFFER FOR
         STW,7    BF3+512,4             THE BAD SECTOR ADDRESSES
         BIR,4    %-1                     AND THE ASSIGNED ALTERNATES
         MVW      =BF3,UT15P        SET POINTER
*
* SEARCH IN THREE WRITE-READ PASSES FOR ALL FLAWS
*
UT15A    EQU      %                 ENTRANCE POINT FOR WRITE/READ LOOP
         LW,4     UT15X             LOAD LOOP INDEX
         LW,7     UT15PTYP,4        GET THE
         STW,7    #PTYP                PATTERN TYPE
         LW,7     UT15PAT0,4            AND
         STW,7    #PBUF                  THE PATTERN DATA
         LW,7     UT15PAT1,4
         STW,7    #PBUF+1
         LW,7     UT15PAT2,4
         STW,7    #PBUF+2
         MTW,1    #PCNT
         BAL,15   CUR:CYL
         DATA     XMWRF
         STW,1    #SEQINH
         STW,0    SKADR
         STW,0    #SCNT
         MTW,1    #PCNT
UT15B1   EQU      %                 ENTRANCE FOR READ OF NEXT CYLINDER
         STH,0    SKADR,1
UT15B2   EQU      %                 ENTRANCE FOR ERROR CONTINUATION
         TEST     XMRDF
         LW,7     #SEQEF            ERROR ANALYSIS
         BEZ      UT15B5            NO ERROR: INCR. CYL. AND GO ON
UT15B31  LW,7     :IO4BD+15         CHECK THE ERROR TYPE
         AND,7    =X'00400000'      TRANSMISSION ERROR
         BNEZ     UT15B4            YES: SUPPRESS ERROR REPORT AND LOG
         STW,0    #SEQINH           RESET PRINT INHIBIT
         BAL,7    #SEQR             REPORT THE ERROR
         STW,1    #SEQINH           SET PRINT INHIBIT
         B        UT15B43
*
UT15B4   EQU      %                 LOGGING OF THE BAD SECTOR ADDRESS
         MVW      SENOBS,SKADR
         LW,5     #CONTX
         CI,5     RMP
         BE       UT15B40
         BAL,15   DECS              DECREMENT SECTOR ADDRESS
UT15B40  RES
         LW,7     SKADR
         LW,4     =BF3              SET INDEX
UT15B41  EQU      %
         CW,7     0,4                  THIS ADDRESS IS ALREADY
         BE       UT15B43
         AI,4     2
         CW,4     UT15P
         BL       UT15B41           NO
         LW,4     UT15P             GET CURRENT POINTER
         STW,7    0,4                 AND
         CW,4     BF3L              CHECK FOR BUFFER OVERFLOW
         BL       %+3               OK
         MTW,1    UT15AF            SET ABORT FLAG
         B        UT15C2            GO TO REPORTING/FLAWING PHASE
         MTW,2    UT15P
UT15B43  EQU      %                 PREPARE THE SEEK
         BAL,15   INCS1
         MTW,0    INCEND            CHECK FOR END
         BEZ      UT15B2            GO ON
         B        UT15C
*
UT15B5   EQU      %
         BAL,15   INCC
*
         MTW,0    INCEND
         BEZ      UT15B1
*
UT15C    EQU      %
         MTW,1    UT15X
         LW,7     UT15X
         CW,7     UT15XL
         BL       UT15A
UT15C2   RES
         MVW      #ALTSK,UT15SK     SET ALTERNATE SEEK ADDRESS
*
*
* FLAWING OPERATION
*
UT15F    RES
         MVW      =BF3,UT15PM       RESET POINTER FOR FLAWING
         CW,7     UT15P
         BE       #EXIT             NO FLAWS FOUND
         MVI      -1,ASKADR         INIT. ASKADR
UT15F0   EQU      %                 ENTRANCE POINT FOR FLAWING NEXT SECT
         LW,5     #CONTX            GET THE CONTOLLER TYPE
         LW,4     =BF3              LOAD INDEX
UT15F1   EQU      %                 CHECK IF ALTERNATE TRACK IS BAD
         LW,7     0,4               CHECK CYLINDER
         AND,7    UT15SM,5          MASK SEEK ADDRESS FOR RDC/RMC/RMP
         CW,7     UT15SK                ADDRESS OF ALT. SECT.
         BE       UT15F5
         AI,4     2
         CW,4     UT15P             ARE ALL TRACKS CHECKED
         BL       UT15F1            NO
         LW,4     UT15PM            YES: PREPARE FOR MODIFYING
         LW,7     0,4               LOAD SEEK ADDRESS
         AND,7    UT15SM,5          MASK SEEK ADDRESS FOR RDC/RMC/RMP
         STW,7    SKADR
         CI,5     RMP
         BE       UT15F2
         CW,7     ASKADR            CHECK IF TRACK ALREADY FLAWED
         BNE      UT15F11           OK: GO ON
         MTW,2    UT15PM            INCR. POINTER
         LW,7     UT15PM            GET POINTER
         CW,7     UT15P               AND CHECK IF THATS ALL
         BL       UT15F0            NO: CONTINUE
         B        UT15G0            ELSE: REPORT
UT15F11  RES
         CW,7     #ALTSK            CHECK IF ALTERNATE TRACK
         BGE      UT15F3            YES: FLAWING ONLY
UT15F2   RES
         LW,7     UT15SK            LOAD THE ALTERNATE ADDRESS
         STW,7    1,4
         STW,7    ASKADR
         MTW,1    #ALTM             SET ALTERNATE ADDRESS MARK
         MTW,1    #FLAWM            SET FLAWMARK INDICATOR
         BAL,7    HFWR              EXECUTE THE MODIFYING HEADER ROUTINE
         CI,5     RMP
         BNE      %+2
         BAL,15   INCS1             INCREMENT SECTOR BY ONE
         MVW      SKADR,ASKADR       AND STORE IT AS RETURN ADR.
         MVW      UT15SK,SKADR      GET ALTERNATE SEEK ADDRESS
         LB,7     SKADR,2           GET SEEK TRACK.
         CI,7     18                LAST TRACK OF 7275 CYL?
         BNE      %+3
         LW,14    #DEVX             YES--7275?
         CI,14    #7275
         BNE      %+4
         BAL,15   INCT1             INCREMENT TO TRACK 0 OF NEXT CYL.
         MTW,0    INCEND            THERE?
         BNE      UT15G0            NO--GIVE REPORT NOW.
         MTW,1    #ALTM
         B        %+2
UT15F3   EQU      %
         MTW,1    #FLAWM            SET FLAWMARK FLAG
         BAL,7    HFWR              FORM AND WRITE HEADER
UT15F4   EQU      %
         MTW,2    UT15PM
         LW,7     UT15PM
         CW,7     UT15P             ARE ALL HEADERS MODIFIED?
         BL       UT15F5            NO
         B        UT15G             YES
UT15F5   EQU      %
         MVW      UT15SK,SKADR
         B        %+1,5             BRANCH ACCORDING TO CONTROLLER TYPE
         B        UT15F7            RDC
         B        UT15F6            RMC
         B        UT15F9            RMP
*
UT15F6   RES
         BAL,15   INCT1                THE ALTERNATE TRACK
UT15F7   EQU      %
         BAL,15   INCT1
         MTW,0    INCEND            CHECK FOR END OF DISK
         BNEZ     UT15G0            END OF DISK
         LW,15    SKADR
         AND,7    UT15SM,5          MASK SEEK ADDRESS FOR RDC/RMC/RMP
         LW,14    #DEVX             GET DEVICE INDEX
         CI,14    #7275             CHECK FOR 7275
         BNE      UT15F8            SKIP IF NOT
         LB,8     15,2              GET TRACK NUMBER
         CI,8     18                CHECK FOR LAST TRACK
         BGE      UT15F7            SKIP THIS TRACK
UT15F8   RES
         STW,15   UT15SK
         B        UT15F0
*
UT15F9   RES
         BAL,15   INCS1             INCREM. SECTOR ADDRESS
         MTW,0    INCEND            CHECK FOR END OF DISK
         BNEZ     UT15G0            END OF DISK
         MVW      SKADR,UT15SK
         B        UT15F0
*
UT15G0   RES
         BAL,R15  *#REPORT          REPORT ALTERNATE DISK POOL EXHAUSTED
         NOP      UT15M2
*
UT15G    EQU      %                 PREPARE FOR THE LISTING
         LW,7     UT15PM            GET MAX. POINTER
         SW,7     =BF3
         STB,7    UT15ET
         BAL,15   *#REPORT
         NOP      UT15M,3
         LI,8     7                 MANIPULATE PRINT CONTROL
         XW,8     #PC                 TO GET THE STUFF OUT TO THE PRINTER
         SEND     UT15ET
         XW,8     #PC               RESTORE #PC
         MTW,0    UT15AF            CHECK ABORT FLAG
         BEZ      #EXIT
         BAL,15   *#REPORT
         NOP      UT15M1,3
         B        #EXIT
*
*
UT15M TEXTS CR,'LIST OF SECTORS WITH FLAWS AND ASSIGNED ALTERNATES',EM
UT15M1 TEXTS CR,'BUFFER OVERFLOW: NOT ALL FLAWS ARE FLAWED',EM
UT15M2   TEXTS    CR,'ALTERNATE DISK POOL EXHAUSTED',EM
*
*
**************************************************************
* VTOC  Write ROUTINE     (U,10)                             *
**************************************************************
*
*
UT16     EQU      %
         LI,R7    X'10006'          GAVAL POINTS TO SECTOR
         STW,R7   FILD+HX%GAVAL**-1   FOLLOWING FIRST FD.
*
         LW,R7    NGC               CALCULATE NGAVAL
         AI,R7    -3                  FOR FIRST FD.
         LI,R0    1                 BUT AT LEAST 30 GRANS MUST BE
         CW,R0    #ACCOUNTS           ALLOCATED FROM THE FIRST
         BL       %+5                 FEW CYLINDERS.
         CI,R7    27
         BGE      %+3               30-VTOC,AD,FD = 27.
         AW,R7    NGC               ANOTHER CYL TO NGAVAL.
         B        %-3
         CI,R7    0                 NGAVAL MUST NOT BE NEGATIVE.
         BG       %+2
         LI,R7    0
         STB,R7   FILD+NGAVAL
         LI,R0    0                 WRITE VTOC, AD, FIRST FD AT SCTR 0.
         STW,0    SKADR             RESET SEEK ADDRESSS
         TEST     XM16
*
         LW,R5    #ACCOUNTS         IF ONLY
         AI,R5    -1                  ONE ACCOUNT,
         BLEZ     #EXIT               WE'RE DONE.
*
         LI,R4    -4                CALC ADDRESS OF FIRST FREE CYL.
         AW,R4    NSC               IF THIS CYL BEGINS FOLLOWING
         BLEZ     %-1                 FIRST FD, START NEXT FD HERE.
         AI,R4    X'10006'          CALC ADDRESS OF NEXT GAVAL
         STW,R4   FILD+HX%GAVAL**-1   AND STORE IN FD.
         LW,R7    #DEVX             SET WVTOC WRITE FLAG WITH
         STH,R7   WVTOCWRT            DEVX OF DRIVE.
*
         AI,R4    -X'10002'         CALC ABS SECTOR # OF THIS FD.
         BAL,R15  INCS1             INCREMENT PREVIOUS 0 SECTOR
         BDR,R4   INCS1               BY THAT AMOUNT.
*
         LW,R4    NGC               CALCULATE NGAVAL FOR
         AI,R4    -1                  REMAINING FDS.
         STB,R4   FILD+NGAVAL
*
         LW,R4    NSC               INIT FD WRITE LOOP.
*
UT16%FDWRIT EQU   %
         CI,R5    1                 ABOUT TO WRITE LAST FD?
         BG       UT16%WRITFD       NOT YET.
*   IF THE NEXT FD IS THE LAST, GIVE IT ANY UNALLOCATED GRANULES
*   WHICH MAKE UP THE 30 MINIMUM.
         LB,R6    FILD+NGAVAL       GET # GRANS UNUSED IN THIS CYL.
         SLS,R6   1                 MAKE SECTORS.
         AW,R6    FILD+HX%GAVAL**-1 CALC GDA OF NEXT UNALLOC CYL.
         AI,R6    -2
         AND,R6   XFFFF             (R6) = # SCTRS ALLOC FROM PACK.
         SLS,R6   -1                CALC # GRANS ALLOCATED.
         LB,R15   FILD+NGAVAL       GET # GRANS UNUSED IN THIS CYL.
         AI,R6    -30               30 MINIMUM ?
         BGEZ     UT16%WRITFD       YES.
         AW,R15   NGC               NO--INCREASE NGAVAL TO CONTAIN
         AW,R6    NGC                 NEXT CYL.
         BLZ      %-2
         STB,R15  FILD+NGAVAL       SAVE NGAVAL.
*
UT16%WRITFD EQU   %
         TEST     XM18              WRITE NEXT FD.
*
         LW,R6    NSC               INCREMENT SEEK ADDRESS
         BAL,R15  INCS1               SO NEXT FD
         BDR,R6   INCS1               BEGINS NEXT CYLINDER.
*
         AWM,R4   FILD+HX%GAVAL**-1 CALC GAVAL OF NEXT FD.
*
         BDR,R5   UT16%FDWRIT       WRITE NEXT FD IF MORE TO GO.
         LI,R7    0
         STW,R7   WVTOCWRT          RESET WVTOC WRITE FLAG.
         B        #EXIT
*
*
*
**************************************************************
* VTOC  READ  ROUTINE     (U,11)                             *
**************************************************************
*
*
UT17     EQU      %
         STW,0    SKADR             RESET SEEK ADDRESSS
         TEST     XM17
         B        #EXIT
*
*
*
*
*****************************************************
* HEADER READ: ANALYSIS    ROUTINE (U,12)      *
*****************************************************
*
*
UT18     EQU      %
         STW,0    RETRY             RESET RETRY
         LI,7     -512
         STW,0    BF3+512,7
         BIR,7    %-1
         STW,0    UT18PT
         LW,7     #PC
         CI,7     1
         BG       %+2
         STW,1    #INH:P
         BAL,15   CUR:SEC
         DATA     XHDR:A
         STW,0    #INH:P
         STW,0    #SEQINH
         MTW,0    UT18PT
         BEZ      #EXIT
         BAL,15   *#REPORT
         NOP      UT18M,3
         LW,7     UT18PT
         CI,7     256               CHECK FOR OVERFLOW CONDITION
         BL       %+3               OK
         BAL,R15  *#REPORT
         NOP      UT18M2,3
         AW,7     UT18PT
         STB,7    UT18R
         LI,8     7                 MANIPULATE PRINT CONTROL
         XW,8     #PC                 TO GET THE STUFF OUT TO THE PRINTER
         SEND     UT18R
         XW,8     #PC               RESTORE #PC
         B        #EXIT
*
*
UT18PT   RES      1
*
UT18X    B        #SEQRP
*
         MTW,0    #SEQEF
         BNEZ     UT18X1
         LW,6     SKADR
         LW,7     =-1
         LW,8     #CONTX            CHECK CONTROLLER TYPE
         CI,R8    RMP
         BE       %+2
         SLD,6    -8
         CD,6     BF2
         BE       #SEQOK
UT18X1   RES
         LW,7     UT18PT
         CI,7     256
         BE       #SEQOK
         LD,8     BF2
         STD,8    BF3,7
         MTW,1    UT18PT
         B        #SEQOK
*
UT18M    TEXTS    CR,'LIST OF FLAWED AND ALTERNATE HEADERS',EM
UT18M2   TEXTS    CR,'LIST OVERFLOW',EM
*
UT18R    DATA     BF3
         GEN,8,24 X'40',0
         DATA     :HU18
*
         B        #EXIT
*
*
*
*
*
**************************************************************
* Header  LIST  ROUTINE    (U,13)                            *
**************************************************************
*
*
UT19     EQU      %
         STW,0    HLISTPI           RESET LIST INHIBIT
         MVW      #ALTSK,SKADR
         LW,7     ACYL
         MW,7     STMAX
         STW,7    #SCNT
UT19A    RES
         TEST     XMHRD
         BAL,R7   HLIST
         MTW,0    HLISTA
         BEZ      #EXIT
         BAL,15   INCT
         MTW,0    INCEND
         BEZ      UT19A
         B        #EXIT
*
*
*
**************************************************************
* Header  FLAW ROUTINE    (U,14)                             *
**************************************************************
*
*
UT20     EQU      %
         MVW      #ALTSK,SKADR
         STW,1    HLISTPI           SET PRINT INHIBIT
         LW,7     ACYL
         MW,7     STMAX
         STW,7    #SCNT
UT20A    RES
         TEST     XMHRD
         BAL,R7   HLIST
         LW,7     HLISTA
         CW,7     SMAX
         BL       UT20B
         BAL,15   INCT
         MTW,0    INCEND
         BEZ      UT20A
         BAL,R15  *#REPORT          REPORT ALTERNATE DISK POOL EXHAUSTED
         NOP      UT15M2
         B        #EXIT
UT20B    RES
         STW,0    UT15AF            RESET ABORT FLAG
         AW,7     SKADR
         STW,7    UT15SK
         B        UT15F             PROCEED WITH FLAWING OPERATION
*
*
*****************************************************
* READ:  SURFACE ANALYSIS ROUTINE (U,18)            *
*****************************************************
*
*
UT24     EQU      %
         LI,R7    X'02'
         MTW,0    #CONTX            CHECK CONTROLLER TYPE
         BNEZ     %+2
         LI,R7    X'08'
         STB,R7   UT24MASK+4
         STW,0    RETRY
         LI,7     -126
         STW,0    BF3+126,7
         BIR,7    %-1
         LW,7     #PC               GET PRINT CONTROL VALUE
         CI,7     1                  CHECK PRINT TYPE
         BG       %+2
         STW,1    #INH:P            SET INHIBIT
         BAL,15   CUR:CYL
         DATA     XRDO
         STW,0    #INH:P
         STW,0    #SEQINH           RESET PRINT INHIBIT
         MTW,0    BF3+125
         BEZ      #EXIT             RETURN NO ERRORS
         BAL,15   *#REPORT
         NOP      UT24M,3           PRINT OFFSET ROUTINE TITLE
         LI,7     19
         LI,5     6
         MW,5     7                 PREPARE HEAD NUMBERS OF LIST
         STW,7    BF3,5
         BDR,7    %-3
         LI,8     7                 MANIPULATE PRINT CONTROL
         XW,8     #PC                 TO GET THE STUFF OUT TO THE PRINTER
         SEND     UT24R
         XW,8     #PC               RESTORE #PC
         B        #EXIT
*
*
*
UT24X    B        #SEQRP
*
*        ANALYZE AND COUNT I/O ERRORS
*
         MTW,0    #SEQEF            CHECK ERROR FLAG
         BEZ      #SEQOK            NO ERROR: RETURN
         MTW,1    BF3+125           INCR. TOTAL COUNT OF ERRORS
         LB,5     SENOBS,2          GET HEAD ADDRESS
         MI,5     6
         MTW,1    BF3+5,5           INCR. TOTAL COUNT FOR EACH HEAD
         LI,7     4
UT24X2   EQU      %
         LW,15    UT24LOC,7         GET DATA LOCATION
         LW,15    *15                 AND THEN GET DATA
         AND,15   UT24MASK,7           AND MASK OUT
         BEZ      UT24X4
         MTW,1    BF3+120,7         INCR. DETAILED COUNT
         LW,6     5
         AW,6     7
         MTW,1    BF3,6             INCR. DETAILED COUNT FOR EACH HEAD
UT24X4   EQU      %
         BDR,7    UT24X2
         B        #SEQOK            RETURN
*
*
UT24R    GEN,8,24 126,BF3
         GEN,8,24 X'40',0
         DATA     UT24H
*
UT24LOC  DATA     0,:IO4BD+15,:IO4BD+15,:IO4BD+15,:IO4BD+15
UT24MASK DATA     0,X'00400000',X'40000000',X'01000000',X'02000000'
*
UT24M  TEXT CR,CR,'LIST OF I/O ERRORS',EM
*
*
*
**************************************************************
*  Single Header Write ROUTINE    (U,1A)
**************************************************************
*
*
UT26     EQU      %
         MVW      #POS,SKADR
         BAL,7    HFWR
         B        #EXIT
*
*
**************************************************************
* Flaw  Mark Header Write ROUTINE    (U,1B)                  *
**************************************************************
*
*
UT27     EQU      %
         MTW,1    #FLAWM
         MTW,1    #ALTM             SET ALTERNATE AREA MODIFY FLAG
         MVW      #POS,SKADR
         MVW      #POS1,ASKADR
         BAL,7    HFWR
         B        #EXIT
*
*
**************************************************************
* Alt. Addr. Header Write ROUTINE    (U,1C)
**************************************************************
*
*
UT28     EQU      %
         MTW,1    #ALTM
         LW,7     #CONTX
         CI,7     RMP
         BNE      UT28A
         MVW      #POS,SKADR
         BAL,15   INCS1
         MVW      SKADR,ASKADR
         B        UT28B
UT28A    RES
         MVW      #POS,ASKADR
UT28B    RES
         MVW      #POS1,SKADR
         BAL,7    HFWR
         B        #EXIT
*
*
*
*
         PAGE
***************************************************************
***************************************************************
***                                                         ***
***                                                         ***
*** TEST MODULES                                            ***
***                                                         ***
***                                                         ***
***************************************************************
***************************************************************
*
*
* THIS PROCEDURE DEFINES THE TEST SUBROUTINE ADDRESSES OR
* PARAMETERS OF A TEST MODULE
*
:HIO     CNAME    :HIO,2
:TIO     CNAME    :TIO,2
IO1      CNAME    :IO1,1
IO4B     CNAME    :IO4B,4
IO5      CNAME    :IO5,5
SK       CNAME    :SK,0
WT       CNAME    :WT,1
SN       CNAME    :SN,0
COMP     CNAME    :COMP,0
PT       CNAME    :PT,0
HCOMP    CNAME    :HCOMP,0
*                                     2 REQUIRED PARAMETERS
         PROC
LF       DATA     NAME(1)
         LOCAL    J
J        DO       NAME(2)
         DATA     AF(J)
         FIN
         LOCAL
 ERROR,0,NUM(AF)>NAME(2) 'PAR>'
 ERROR,0,NUM(AF)<NAME(2) 'PAR<'
         PEND
*
*
TS       CNAME
         PROC
LF       EQU      %
TSLOC    SET      %
         ORG      %+1
         PEND
*
TE       CNAME
         PROC
TELOC    SET      %
         ORG      TSLOC
         DATA     TELOC
         ORG      TELOC
         PEND
*
*
*
*
**************************************************************
* HIO  TM                                                    *
**************************************************************
*
XM01     TS
         :HIO     X'60',0
         TE
*
**************************************************************
* HIO AND RESTORE TM                                         *
**************************************************************
*
XM02     TS
         :HIO     X'60',0
         IO5      IOCDXB3,X'08000000',X'10000000',0,1
         TE
*
XM02RDC  TS
         :HIO     X'60',0
         IO5      IOCDX33,X'00100000',X'10000000',0,1
         WT       2
         TE
*
**************************************************************
* HIO      / SENSE TM                                        *
**************************************************************
*
XM04     TS
         :HIO     X'60',0
         SN
         TE
*
*
*
*
**************************************************************
* VTOC  Write  S.C.I.     (U,10)                             *
**************************************************************
*
XM16     TS
         SK
         IO1      IOCD16
         SN
         TE
*
**************************************************************
* VTOC  READ   S.C.I.     (U,11)                             *
**************************************************************
*
XM17     TS
         SK
         IO1      IOCD17
         SN
         TE
*
*
*
*
*
***********************************************************************
* FD     WRITE   S.C.I.      (U,??)                                    *
***********************************************************************
*
XM18     TS
         SK
         IO1      IOCD18
         SN
         TE
*
**************************************************************
* Fast  Write                                                *
**************************************************************
*
XMWRF    TS
         PT
         SK
XMWRFIO  IO4B     IOCDWRF,X'00180040',X'18000000',X'20000000'
         SN
         TE
*
**************************************************************
* Fast  Read                                                 *
**************************************************************
*
XMRDF    TS
         PT
         DATA     :CB2
         SK
XMRDFIO  IO4B     IOCDRDF,X'00180040',X'18000000',X'20000000'
         COMP
         SN
         TE
*
**************************************************************
* Fast  Check Write                                          *
**************************************************************
*
XMCWF    TS
         PT
         SK
XMCWFIO IO4B     IOCDCWF,X'00180040',X'18000000',X'20000000'
         SN
         TE
*
**************************************************************
* Slow  Write                                                *
**************************************************************
*
XMWRS    TS
         PT
         SK
         IO1      IOCDWRS
         SN
         TE
*
**************************************************************
* Slow  Read                                                 *
**************************************************************
*
XMRDS    TS
         PT
         DATA     :CB2
         SK
         IO1      IOCDRDS
         COMP
         SN
         TE
*
**************************************************************
* Slow  Check Write                                          *
**************************************************************
*
XMCWS    TS
         PT
         SK
         IO1      IOCDCWS
         SN
         TE
*
**************************************************************
* Header  Write                                              *
**************************************************************
*
XMHWR    TS
         DATA     :HPAT
         SK
         DATA     :PHBUF
         IO1      IOCDX09
         TE
*
**************************************************************
* Header  Read                                               *
**************************************************************
*
XMHRD    TS
         DATA     :HPAT
         DATA     :CB2
         SK
         DATA     :IO1H,IOCDX0A
         HCOMP
         SN
         TE
*
**************************************************************
* Header  Write                                              *
**************************************************************
*
XMHWR1   TS
         SK
         DATA     :PHBUF
         IO1      IOCDX09
         TE
*
**************************************************************
* Header  Read                                               *
**************************************************************
*
XMHRD1   TS
         SK
         DATA     :IO1H,IOCDX0A1
         SN
         TE
*
*
XMHRD2   TS
         SK
         DATA     :CB2
         DATA     :IO1H,IOCDX0A
         SN
         TE
*
*
**************************************************************
* SURFACE ANALYSIS
**************************************************************
*
XRDO     TS
         SK
XRDOIO   IO4B     IOCDRDF,X'00180040',X'18000000',X'20000000'
         SN
         DATA     UT24X
         TE
*
         TE
*
*
**************************************************************
* SURFACE ANALYSIS
**************************************************************
*
XHDR:A   TS
         SK
         DATA     :IO1H,IOCDX0AS
         DATA     UT18X
         TE
*
*
**************************************************************
* DEVICE STATUS ANALYSIS
**************************************************************
*
XTIO:A   TS
         :HIO     0,0
         :TIO     X'600000C0',0
         DATA     TIO:A
         TE
*
*
TIO:A    B        %+2
         B        #SEQOK
         MTW,0    #SEQEF            CHECK IF TIO CAUSED AN ERROR
         BEZ      #SEQRP            NO: RETURN
         LW,7     :TIOD+2           GET OBSERVED TIO STATUS
         AND,7    =X'C0'            CHECK FOR
         CI,7     X'C0'              NO ADDRESS RECOGNITION
         BNE      TIO:A2            NO: CONTINUE
         BAL,15   *#REPORT
         NOP      TIO:AM1
         B        #END
TIO:A2   RES
         LW,7     :TIOD+2
         AND,7    =X'60000000'
         CW,7     =X'20000000'      CHECK FOR NOT
         BNE      TIO:A4                 OPERATIONAL
         BAL,15   *#REPORT
         NOP      TIO:AM2
         B        #END
TIO:A4   RES
         CW,7     =X'40000000'      CHECK FOR
         BNE      #SEQRP
         BAL,15   *#REPORT              DEVICE UNAVAILABLE
         NOP      TIO:AM3
         B        #END
*
TIO:AM1  TEXTS    'NO DEVICE ADDRESS RECOGNITION',CR,EM
TIO:AM2  TEXTS    'DEVICE NOT OPERATIONAL',CR,EM
TIO:AM3  TEXTS    'DEVICE RESERVED BY OTHER CHANNEL',CR,EM
*
*
*
XSEN:A   TS
         DATA     SEN:AI
         IO1      IOCDX04
         DATA     SEN:A
         TE
*
*
SEN:AI   B        #SEQRP
         LI,4     -4                CLEAR SENSE BUFFER
         STW,0    SENOBS+4,4
         BIR,4    %-1
         B        #SEQOK
*
SEN:A    B        SEN:A6
         LW,4     #CONTX
         BEZ      #SEQOK
         CI,4     1
         BNE      SEN:A2
         LW,7     SENOBS
         AND,7    =X'80000000'
         BEZ      #SEQOK
         B        #SEQER
SEN:A2   RES
         LW,7     SENOBS+1
         AND,7    =X'00100000'
         BEZ      #SEQOK
         B        #SEQER
SEN:A6   RES
         MTW,0    #SEQEF            CHECK ERROR FLAG
         BEZ      #SEQRP            RETURN
         LW,4     #CONTX
         BEZ      #SEQRP
         BAL,15   *#REPORT
         NOP      SEN:AM
         B        #END
*
*
SEN:AM   TEXTS    'DEVICE IS WRITE PROTECTED',CR,EM
*
*
         PAGE
***************************************************************
***************************************************************
***                                                         ***
***                                                         ***
*** TABLES AND BUFFERS                                      ***
***                                                         ***
***                                                         ***
***                                                         ***
***************************************************************
***************************************************************
*
*
*
*        HPROC PROCEDURE
*
HPROC    CNAME
         PROC
LF       GEN,8,8,8,8  AF(1),AF(2),AF(3),AF(4)
I        DO       NUM(AF)/4
         GEN,8,8,8,8  AF(4*I+1),AF(4*I+2),AF(4*I+3),AF(4*I+4)
         FIN
         PEND
*
*
*
*        *** HEADER INDEX LIST TABLE ***
*
:H1      HPROC    41,33,34          CA     COM1     COM2
:H3      HPROC    43                TIO  CC
:H6      HPROC    44                HIO  CC
:H8      HPROC    45,37             TYP  TIME
:H10     HPROC    42,52,54,43,51,53,41
:H13     HPROC    39                SEEK
:H14     HPROC    40,56,56,56         SENSE
:H15     HPROC    06,36,06,38,01
*                                   LOC  EXP  LOC  OBS  CNT
:H18     HPROC    42,51,53,41,44,43
*
:H22     HPROC    54,55,01
:H23     HPROC    32
:H24     HPROC    32,56
*
:H30     HPROC    45,06,48,04      TYP ADDR LEN  DATA
:H31     HPROC    45,06,48,04,49
*                                   TYP  ADDR LEN  DATA INC
:H32     HPROC    45,06,48,50        TYP ADDR LEN  SEED
:H33     HPROC    45,06,48          TYP  ADDR LEN
:H34     HPROC    04,56,56        DATA '   '   '
:H35     HPROC    04,56,56,56       DATA '3 BLANKS
:H36     HPROC    04,56,56,56
:H39     HPROC    06,04,04
:H45     HPROC    32
:H46     HPROC    06,06,48,04
:H47     HPROC    06,62,06,63,38,01
*
:HU15    HPROC    60,61
:HU18    HPROC    60,61
*
UT24H    HPROC    65,66,67,68,69,70
*
*
*
***************************************************************
*        ***IOCD TABLE***
***************************************************************
*
         BOUND    8
*
IOCDX33  IOCD     X'33',BA(SKADR),X'1C',1
IOCDX83  IOCD     X'83',BA(SKADR),X'0C',4
IOCDX04  IOCD     4,BA(SENOBS),X'1C',16
* THE HEADER WRITE OPERATION IS PERFORMED WITH A SEEK COMMAND CHAINED
* TO THE THE HEADER WRITE IN ORDER TO REDUCE THE IMPACT OF A RMP
* PROBLEM, WHICH REPORTS ERRONEOUSLY WRONG SECTOR ERRORS.
*
IOCDX09  IOCD     3,BA(SKADR),X'2C',4                                  #29040
         IOCD     9,BA(BF1),X'1C',0                                    #29040
IOCDX0A  IOCD     X'0A',BA(BF2),X'1C',0
IOCDX0AS IOCD     X'0A',BA(BF2),X'1C',8
IOCDX0A1 IOCD     X'0A',BA(BF1),X'1C',0
IOCDXB3  IOCD     X'B3',BA(BF1),X'0C',1
IOCDWRF  IOCD     1,BA(BF1),X'9C',1024
         IOCD     8,DA(%-2),0,0
IOCDRDF  IOCD     X'12',BA(BF2),X'9C',1024
         IOCD     8,DA(%-2),0,0
IOCDCWF  IOCD     5,BA(BF1),X'9C',1024
         IOCD     8,DA(%-2),0,0
IOCDWRS  IOCD     1,BA(BF1),X'1C',1024
IOCDRDS  IOCD     X'12',BA(BF2),X'1C',1024
IOCDCWS  IOCD     5,BA(BF1),X'1C',1024
*
IOCD16   IOCD     1,BA(VTOC),X'9C',2048
         IOCD     1,BA(VTOC+512),X'9C',2048
IOCD18   IOCD     1,BA(FILD),X'1C',2048 FILE DIRECTORY WRITE.
IOCD17   IOCD     2,BA(BF1),X'9C',2048
         IOCD     2,BA(BF1+512),X'9C',2048
         IOCD     2,BA(BF1+1024),X'1C',2048
*
*
***************************************************************
*        *** I/O BUFFERS ***
***************************************************************
*
SKADR    DATA     0                 SEEK ADDRESS
TMODB    DATA     0                 TMS BUFFER
SENMAS   RES      4                 MASK FOR SENSE DATA
SENEXP   RES      4                 EXPECTED SENSE DATA
SENOBS   RES      4                 OBSERVED SENSE DATA
*
*
         PSECT    0
*
BF1      RES      512
BF2      RES      512
BF3      RES      512
*
BF3L     RES
*
         CSECT    1
*
         END      INITIAL

