         DEF      BOOTSUBR
BOOTSUBR EQU      %
         DEF      TBOOT:
         SYSTEM   UTS
OC       EQU      2
CR       EQU      4
LP       EQU      6
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
         REF      DCT1,DCT4,M:SWAPD
         REF      OB:BOPTX,DCTSIZ
         REF      OCNDD,CNDD,LLNDD
         REF      JXBUFVP
         REF      JITLOC,J:JIT
         REF      JOVVP
         REF      JJITVP
         REF      FPMC
         REF      JX:CMAP
         REF      JCCL
         REF      J:CL
         REF      JH:DA
         REF      S:MAPCW
         REF      S:ACCW,DCT1A,DCT1P
         REF      P:TCB
         REF      P:SA
         REF      PB:HVA,PB:PVA,PB:DCBSZ,PB:DSZ,PB:PSZ,MAXOVLY
         REF      PH:DDA,PH:PDA
         REF      RCVRAD
         REF      M:OC
         REF      RCVSIZE
         REF      SYSVERS
         REF      RCVSTART
         REF      RCVDISC
         SREF     COCBUF
         REF      :BIG
         REF      DCT16
         REF      DCT22                                                 DISCB
         REF      PSA%END                                               DISCB
         REF      NSPT
         REF      NCYL
         REF      CYL%SHFT
         REF      TRK%SHFT
         REF      SEC%SHFT
         REF      M24
          REF       NSPC
         REF      MB:SDI,MB:SWAPS,LSWAP
         REF      DSCCVT
         REF      SEEK4000
         REF      DATE
         REF      TOPROOT
         REF      M16
         REF      DLTBIAS
         REF      UMOV#
         DEF      DLTSZ
         REF      XFFFF00
         REF      SPOOL
         REF      S:DP
         SREF     PB:C#,PB:DC#
         SREF     PPTABLE,PPTABLSZ,PPTABDSK,RDPPTAB
         SREF     PP:UPPH,PP:UPPT,PP:UPPC
         REF      M:FPPH,M:FPPT,M:FPPC
         REF      MX:PPUT
         SREF      RESDFP,PPTABDSK2,DYNRESDF,MDYNRESDF
         REF      LOW,HIGH
         REF      CORE,CORED
         REF      SL:CORE
         REF      S:ACORE
         REF      S:PCORE
         REF      MP:UPPH,MP:UPPT,MP:UPPC
Y04      EQU      BT31TO0+27
         SREF     S:UCYL
         REF      LEE20
         SREF     S:CYLSZ
         REF      RTICBHDR
         SREF     RESDF
         DEF      MONINIT,ROOTSA
         DEF      BOOTENT
         REF      BOOTIC            TIC COMMAND IN TABLES
         PAGE
*****************
*  LOC.'2A' VALUES
*
*        0        INDETERMINATE
*        1        COLD TAPE BOOT
*        2        BOOT UNDER FILES (TAPE)
*        3        RAD BOOT
*        4        RECOVERY
*        5        OPERATOR RECOVERY
*
*****************
         SPACE    3
*
MONINIT  EQU      %
         STW,11   MONIRTN
         LI,1     60000
         BDR,1    %                 APP.60 MIL.SEC.DELAY FOR 560
         LI,1     X'80'             ASSUME SIGMA 7
         LW,3     NSIG7XPSD
         XW,3     X'4D'             SET UP TRAP
         AD,11    4                 WILL TRAP IF ON SIG9 OR X560
         STW,3    X'4D'             RESTORE TRAP
         STB,1    CSED%MACHINE      SET UP BIT FOR BIF PROC
         LI,1     OC                OC OP LABEL INDEX
         LB,1     OB:BOPTX,1        DCTX OF OC
         LI,2     7
         STB,1    M:OC,2            STICK IN M:OC
********
*  IF TTY ADDR. NOT = DCT1 VALUE, WAIT FOR OPERATOR TO PUT NEW TTY
*    ADDR. INTO REGISTER 0 & THEN PROCEED.  NEW ADDR. WILL BE PUT
*    INTO APPROPRIATE DCT TABLES.
********
         LH,R0    DCT1,R1           GET SYSGENED OC ADDR.
         INT,R15  X'2A'
         AI,R15   -4
         BLZ      CHKOCAD     NO--- TAPE BOOT
         LI,R2    2           YES--
         LB,R8    R0,R2             GET 'N' FROM DEV.ADDR.
         BAL,R15  CL2PA       ****  CONVERT 'N' TO HEX
         BCS,1    %           %%%%%%BAD SYSGENED VALUE FOR TTY
         STB,R8   R0,R2             REPLACE 'N' WITH HEX VALUE
CHKOCAD  EQU      %
         STW,R0   OCNDD             SET OC ADDR.
         LCI      0                 RESET CC'S
         HIO,0    *R0         IIOO  SEE IF TTY(OC) ADDR.OK
         BCR,14   OCADDROK    YES-- OC ADDR.OK
WAITOC   EQU      %           NO---
         WAIT     0                 WAIT FOR OPERATOR TO ENTER OC ADDR.
         CI,R15   0
         BLZ      %+2         NO--- TAPE BOOT
         STW,R1   OCNDDFLG    YES-- SET FLAG SO RECNFIG WILL SET DCT16
         AND,R0   M16
         SLS,R0   -8
         BIF,X560 XRX560      YES-- IS THIS XEROX 560
         CI,R0    'H'-'A'     NO--- SIGMA
         BG       WAITOC      NO--- VALID 'N'
         B        CHKOCAD     YES--
*----------------
XRX560   EQU      %
         CI,R0    X560CUCLL
         BG       WAITOC      NO--- VALID CLUSTER/UNIT
         B        CHKOCAD     YES--
*----------------
OCADDROK EQU      %
SYSTRT   EQU      X'26'
         DEF      SYSTRT
BOOTFLG  EQU      X'27'
         DEF      BOOTFLG
         LI,1     X'C0'
         STB,1    BOOTFLG           SET DEFAULT FOR DISC BOOTS (I,P)
         LW,11    CORXPSD           LETS FIND
         XW,11    X'40'             OUT HOW MUCH
         LI,2     CORE+X'FFF'       CORE WE REALLY HAVE
CORC     AI,2     -X'1000'
         MTW,0    0,2
         STW,2    CORED             SAVE ACTUAL SIZE
         MTW,1    CORED
         STW,11   X'40'
         SLS,2    -9
         STW,2    M:FPPT
         STW,2    HIGH
         INT,11   X'2A'             IS THIS ONE
         BCR,15   REQDELT           NO RT OR DATE/TIME MSG IF RECOVERY
         LW,0     MPBR              SET UP BRANCH FOR SYSTRT
         STW,0    SYSTRT
         AI,11    -4                MAKE NEGATIVE FOR NEXT CHECK
         BLZ      RT                YES, SKIP CONTROL QUERY
         LI,0     DA(1STMES)
         BAL,10   MESSG
         LI,5     X'10'             DEFAULT FOR NO RESPONSE (T)
         LI,2     -12               MAX INPUT
         AI,3     0                 IF NO INPUT, USE DEFAULT
         BEZ      CODFLT
         LI,5     0                 CLEAR ACCUMULATOR
CODLOOP  LB,4     BUF+3,2           GET NEXT INPUT CHAR
         BEZ      CODFLT            NO MORE
         LB,3     CODES             SEARCH TABLE
         CB,4     CODES,3
         BNE      %+2
         OR,5     BT31TO0+2,3       GOT ONE
         BDR,3    %-3
         BIR,2    CODLOOP           TO NXT CHAR INPUT
CODFLT   STB,5    BOOTFLG           STICK IT IN
         CI,5     8                 IS THIS BOOT-UNDER-FILES
         BANZ     %+3
         LI,1     -1
         STW,1    X'2A'             YES, SET FLAG
         STW,4    BUF               ZAP BUF FOR NO OC MODE
RT       LW,0     RTICBHDR          IS  THIS A REAL-TIME SYSTEM?
         BLZ      NORT              NO
* # OF PAGES TO MESSAGE
         LW,1     RESDF             # OF PAGES
         CI,1     999               IS SYSGEN PARAM OK
         BLE      %+3               YES
         LI,1     999               NO-FIX IT UP
         STW,1    RESDF
         LI,2     11                INDEX INTO MESSAGE
RT2      LI,0     0
         DW,0     =10               CONVER HEX TO EBCDIC DECIMAL
         AI,0     X'F0'
         STB,0    RESTRD,2
         AI,2     -1
         CI,2     8                 MAXIMUM OF 3 CHARACTERS
         BNE      RT2
* FIRST RESDF PAGE TO MESSAGE
         LW,1     RESDFP            1ST RESDF PAGE
         SLS,1    12                LEFT JUSTIFIED
         LI,2     13                INDEX INTO MESSAGE
         LI,3     5                 # OF CHARACTERS
         BAL,4    CVTEBC            CONVERT AND STORE IN MESSAGE
         LI,0     DA(RESDFCP)
         LC       BOOTFLG           IF NO OC-NO MESSG
         BCR,8    %+2
* GET INPUT FROM OPERATOR
RTMSG    BAL,10   MESSG             OUTPUT MESSAGE
         LW,7     RESDF             # OF PAGES
         LW,8     RESDFP            1ST PAGE
         LI,4     0                 INDEX INTO BUF
* CONVERT # OF PAGES TO HEX
         BAL,1    CVTHEX            VALIDATE CHARS AND BUMP INDEX
RTMSG2   CI,6     0                 ANY INPUT
         BE       RTMSG4            NO
         LW,7     5                 SET NEW # OF PAGES
         CI,7     999               VALID # OF PAGES
         BG       RTMSG             NO
RTMSG4   BAL,1    CVTHEX            GET PAGE ADDR IF ANY
         CI,6     0                 ANY INPUT
         BE       %+2               NO
         LW,8     2                 GET NEW PAGE ADDRESS
         CI,8     0
         BE       %+3               0 IS OK-MAY BE RELEASING RESDF
         CI,8     X'10000'          > OR = 64K
         BL       RTMSG             NO-BAD ADDRESS
         LW,10    8                 SAVE WORD ADDRESS
         SLS,8    -9                GET # OF 1ST PAGE
         LW,9     7                 # OF PAGES TO R9
         AW,7     8                 # OF PAGES + 1ST PAGE
         AI,7     -1                 -1 = LAST PAGE
         CW,7     HIGH              DO THE PAGES EXIST
         BG       RTMSG             NO
         STW,9    RESDF             RESET VALUES
         STW,10   RESDFP
         SLS,9    16                # OF PAGES TO BITS 0-15
         SLD,8    16                BUILD PPTABLE ENTRY
         STW,8    PPTABLE
         B        NORT
*
CVTEBC   EQU      %                 CONVERT HEX CHARACTERS TO EBCDIC
         LI,0     0                 AND STORE THEM IN RESET RESDF MSG
         SLD,0    4                 R1 HAS CHARACTERS LEFT JUSTIFIED
         AI,0     X'F0'
         CI,0     X'F9'
         BLE      %+2
         AI,0     -X'39'
         STB,0    RESTRD,2          R2=INDEX INTO MESSAGE
         AI,2     1
         BDR,3    CVTEBC            R3=# OF CHARACTERS TO CONVERT
         B        0,4
*
CVTHEX   EQU      %                 GET EBCDIC ANSWER FROM BUF AND
         LI,2     0                 CONVERT THEM TO HEX
         LI,5     0                 FOR DECIMAL INPUT
         LI,6     0                 INITIALIZE COUNT OF # CHARACTERS
CVTHEX2  LB,3     BUF,4             R4=POINTER INTO BUF
         BEZ      0,1               EOM
         AI,4     1                 BUMP INDEX
         CI,3     C','              ONLY POSSIBLE DELIMITER
         BE       0,1
         CI,1     RTMSG2            IS THIS THE DECIMAL # OF PGS
         BE       %+3               YES; A-F IS ILLEGAL
         CLM,3    ALFA              MAKE SURE IT IS 0-F
         BCR,9    %+3
         CLM,3    NUMR
         BCS,9    RTMSG
         AI,3     -X'F0'            CONVERT TO HEX
         CI,1     RTMSG2            IS THIS THE DECIMAL # OF PGS
         BE       CVTHEX4           YES
         CI,3     0
         BGE      %+2               0-9
         AI,3     X'39'             A-F
         SLS,3    28
         SLD,2    4                 BUILD ANSWER IN R2
CVTHEX3  AI,6     1                 BUMP COUNT
         B        CVTHEX2
*
CVTHEX4  MI,5     10                SHIFT PREVIOUS ANSWER
         AW,5     3                 SUM UP ANSWER
         B        CVTHEX3           CONTINUE
*
NORT     EQU      %
DATETIME EQU      %
         LI,0     DA(GDATE)
         BAL,10   MESSG             GET DATE
         LI,8     '/'
         STB,8    BUF,3             MM/DD/YY/
         LI,7     5
         LI,3     -8
         LI,1     -1
GETDIG   LB,0     BUF+2,3
         CW,0     8
         BE       GOTIT
         CI,0     '0'
         BL       EOM
         STB,0    1
         SCS,1    8
         BIR,3    GETDIG
         CB,8     BUF+2,3
         BE       GOTIT
NXTFLD   BIR,3    GETDIG-1
         B        EOM               NOT ENOUGH FIELDS
GOTIT    CI,1     -1
         BE       EOM
         CI,1     -16
         BL       %+2
         AI,1     -X'F00'           ONE DIGIT FIELD
         CH,1     MAXD,7
         BG       EOM
         CH,1     MIND,7
         BL       EOM
         LB,2     STORE,7
         STH,1    DATE,2
         LB,7     NEXTI,7
         BNEZ     NXTFLD
         CI,8     '/'
         BNE      REQDELT           RETURN AFTER TIME
         LW,2     DATE
         LI,6     6
         CW,2     BADATES,6         CHECK LEGALITY
         BE       EOM
         BDR,6    %-2
         CW,2     BADATES           FEB 29
         BNE      TIME
         LI,2     X'103'
         AND,2    1
         BEZ      TIME              20I+4J LEAP YEAR
         CI,2     X'102'
         BNE      EOM               NOT 20I+4J+12 LEAP YEAR
TIME     RES
         LI,0     DA(GTIME)
         BAL,10   MESSG
         LI,8     ':'
         STB,8    BUF,3             HH:MM:
         LI,7     2
         B        GETDIG-2
MIND     TEXT     '  0000700101'    DUMMY,MIN,HR,YR,D,MO
MAXD     TEXT     '  5923993112'    DUMMY,MIN,HR,YR,D,MO
STORE    DATA,8   X'0005040301000000'
NEXTI    DATA,8   X'0000010003040000'
BADATES  TEXT     '0229023002310431063109311131'
         PAGE
REQDELT  RES
         LI,0     0
         STW,0    *X'54'            ZAP CLOCK SO TIME IS CORRECT
         BDR,11   TBOOT:            NO DELTA MSG ON TAPE BOOT
         LI,0     DA(RDLT)
         BAL,10   MESSG
         LB,1     BUF
         CI,1     'Y'
         BNE      %+3
         LI,1     X'C4'             SET D FLAG
         STB,1    BOOTFLG
GMONEX   LI,0     DA(DLTCLST)       NOW READ IN DELTA AND THE MONITOR EXTENSION
         LI,4     FIXPPUT
SWAPREAD :SIO,0   *M:SWAPD
         WAIT
         :TIO,2   *M:SWAPD
         WAIT
         BCS,12   :A
         CW,3     ERRMSK
         BANZ     SWAPREAD          TRY AGAIN IF ERRORS
         B        0,4
FIXPPUT  LI,1     TOPROOT+255       GET THE FREE SYMBIONT
         CI,1     256               BUFFER
         BAZ      %+3               IF THERE IS ONE
         AND,1    XFFFF00
         STW,1    SPOOL
         AI,1     256
         SLS,1    -9
         STW,1    M:FPPH
         STW,1    LOW
         LW,2     HIGH
         LI,0     0
         STORE,0  MX:PPUT,2
         SW,2     LOW
         AI,2     1
         STW,2    SL:CORE
         LI,3     JJITVP-1          TAKE OUT MON JIT
         INT,5    UMOV#             AND UMOV PAGES
         LB,5     PB:HVA,5
         STORE,5  MX:PPUT,3
         AI,5     -JJITVP
         SW,2     5
         STW,5    MP:UPPC           SET COUNT
         AI,5     JJITVP-1
         STORE,0  MX:PPUT,5         ZAP TAIL
         STW,5    MP:UPPT
         LI,3     JJITVP
         STW,3    MP:UPPH
         LW,1     Y04               REMOVE DELTA'S PAGES IF KEPT
         AND,1    BOOTFLG
         BEZ      NODELTA
         INT,3    DLTBIAS
         SLS,3    -9
         STORE,3  MX:PPUT,5         HOOK TO OLD TAIL
         AI,3     -1
         INT,1    DLTSZ
         AI,1     X'7FF'
         SLS,1    -11
         AWM,1    MP:UPPC           **
         LOAD,4   MX:PPUT,3         REMOVE DELTAS PAGES
         AW,4     1
         AI,4     -1
         STW,4    MP:UPPT           **
         LOAD,11  MX:PPUT,4         PICK UP OLD FWD LINK
         BNEZ     %+2               IS IT IN XDELTA
         STW,3    M:FPPT            YES- CUT CHAIN BEFORE XDELTA
         STORE,11 MX:PPUT,3         BECOMES NEW FWD LNK
         STORE,0  MX:PPUT,4
         SW,2     1                 REMOVE DELTA'S PAGES FROM COUNT
         MTW,-1   LEE20+2
NODELTA  RES
         MTW,1    LEE20+2
         LI,11    X'B8'             MAX USER SWAP SIZE
         LW,3     S:DP
         BEZ      NOF
*        MAKE MAX USER SIZE EQUAL TO S:CYLSZ IF S:UCYL=1.
*        IF S:UCYL=2, MAX USER SIZE = ((S:CYLSZ-2)/4)*4+2
*
         LW,11    S:CYLSZ
         SW,3     S:UCYL
         BEZ      NOF
         AI,11    -2
         SLS,11   -2
         SLS,11   2
         AI,11    2
         AW,11    S:CYLSZ
NOF      EQU      %
         CW,11    SL:CORE           MAX FOR AJIT
         BGE      %+2
         STW,11   SL:CORE
         STW,2    M:FPPC
         STW,2    S:ACORE
         AI,2     -7                AJIT + 6 PGS FOR OVERLAY
         STW,2    S:PCORE           SAVE PPUT SIZE
         B        PUTRT
CORXPSD  XPSD,10  COREPSD
         BOUND    8
COREPSD  :PSD     RES,(IA,CORC)
TBOOT:   CSECT    0                 NEW CSECT FOR TAPE BOOT CODE
         BAL,R15  RECNFG:0    ****  INITIALIZE DCT TABLES
         LI,0     0
         STW,0    BUF               INITIALIZE BUFFER
         LI,0     DA(DFALT)
         LC       BOOTFLG           IF NO OC, USE YES
         BCR,8    %+2
         BAL,10   MESSG             ASSIGNS OK(YES/NO)
         LW,6     BUF
         BEZ      %+5               NO INPUT, USE YES
         CW,6     NO
         BE       %+3
         SW,6     YES
         BNEZ     EOM
         LI,2     CR                CR TYPE CODE
         BAL,5    VALINP            CNDD
         STW,9    CNDD
         LI,2     LP                LP TYPE CODE
         BAL,5    VALINP            LPNDD
         STW,9    LLNDD
         REF      DCT8,PRTOUTL
         LW,7     DCT8,1            IF DEVICE IS LOW SPEED, SET FLAG
         CI,7     PRTOUTL
         BNE      %+2
         MTB,-1   LLNDD
         LI,7     0
GETDC1   EQU      %
         LB,1     MB:SDI,7          SWAPPER DCT INDEX
         BAL,5    VALINP1           GO-CONVERT DCTX INTO ADDRESS
         STW,9    M:SWAPD,7
         LD,R12   DCT16,R1          GET YYNDD
         SLD,R12  8
         AI,R12   X'15'             NEW LINE
         LW,2     S:DP              TEST FOR PACK SWAPPING
         BEZ      GETDC2            NOT DOING IT
CT1      EQU      %
         LI,10    0                 READ HEADERS A CYLINDER ATA ATIME
         STW,10   SEEK              STARTING AT 0,0,0
         LW,9     S:CYLSZ           # GRANULES IN CYLINDER
         SLS,9    4                 8 BYTES PER HEADER/SECTOR
         STS,9    CMD+3             SET BYTE COUNT
         INT,9    PSA%END           # SECTORS PSA
         SLS,9    -1                # GRANULES PSA
         DW,9     S:CYLSZ           # CYLINDERS PSA
         :HIO,0   *M:SWAPD          RESET
CT2      LI,0     DA(CMD)
         :SIO,0   *M:SWAPD          READ A BUNCH OF HEADERS
         BCS,12   BADDPX
CT3      WAIT     0
         :TIO,0   *M:SWAPD          CHECK COMPLETON
         BCS,12   CT3
         :TDV,3   *M:SWAPD          CHEKC STATUS
         LC       SENSW
         BCS,8    WRTPRT            DISK PACK WRITE PROTECTED
         LD,14    INFOBUF           CHECK FIRST ADDRESS
         SLD,14   8
         CW,14    SEEK
         BNE      BADDP1
         LI,1     'DP'
         LC       3                 TEST STAUTS BITS
         BCS,2    BADDP             SECTOR UNAVAILABLE, CYLS TOO SMALL
         BCS,4    FLAW              FLAW MARK DETECTED
         MTH,1    SEEK              INCR CYL #
         BDR,9    CT2               OK, TO NEXT CYILNDER
         B        DCDPOK            LOOKS GOOD
GETDC2   EQU      %
         LI,0     DA(CLIST)         CHECK DISC TYPE
         :HIO,0   *9
         :SIO,0   *9
         BCS,12   BADISC            DONT WAIT IF DEVICE NOT PRESENT
CT4      RES
         WAIT     0                 SKIP 4 PAGES
         :TIO,0   *9
         BCS,12   CT4               CONTINUE WAITIONG
         LH,0     SENSW
         LB,1     MB:SWAPS,7
         AI,1     1
         CI,0     X'56'             w7232
         BDR,1    %+2
         CI,0     X'80'             7212
         BNE      BADISC
         LC       SENSW
         BCS,8    WRTPRT            RAD WRITE PROTECTED
         STW,0    SENSW
         AI,7     1
         CI,7     LSWAP
         BLE      GETDC1
DCDPOK   EQU      %
         PAGE
*
*
         LI,8     2
         MTW,0    S:DP
         BNEZ     %+2
         LI,8     DAJ               JIT DISC ADR
DAJ      EQU      6
         DEF      DAJ
*DAJ IS WHERE JIT LIVES
*SECTORS 2-5 ARE FOR ALLOCAT'S AJIT AND JIT TO SWAP TO
J        EQU      JITLOC-J:JIT
         LB,4     MB:SDI
         STH,4    8                 DCT X AND RELATIVE SECT #
         BAL,11   DSCCVT            RELATIVE TO ACTUAL DISC ADR
         STW,8    DISCLOC
         LI,5     256-JXBUFVP
         LI,3     JXBUFVP
         LI,2     FPMC
         STORE,2  JX:CMAP+J,3
         AI,3     1                 TO END
         BDR,5    %-2
         LI,5     JJITVP
         STORE,5  JX:CMAP,5         INITIALIZE JJITVP BYTE/HW
         LI,R5    :BIG
         BNEZ     1A3               DONT INITIALIZE CL ON BIG9S.
         LCI      4
         LM,12    JCLIST            BASIC CLIST
         LI,5     -JCCL             CLIST LENGTH
         SAS,5    -1
         LI,2     J:CL+J+JCCL
1A1      LI,3     4
         STD,12   *2,5               STORE SEEK
         AI,12    2                 INC BA(DAT)
1A2      AI,5     1
         BGEZ     1A3
         STD,14   *2,5              STORE FOUR WRITES
         BDR,3    1A2
          BIR,5  1A1                NEXT SEEK
1A3      EQU      %
         LI,5     JOVVP             INITIALIZE MMC CONTROL WORDS
         SLS,R5   :BIG-2            FOR SWAPPER
         AWM,5    S:MAPCW
         SLS,R5   -2-:BIG
         AWM,5    S:ACCW
         LI,5     X'100'-JOVVP
         SLS,R5   :BIG-2
         STB,5    S:MAPCW+1
         SLS,R5   -2-:BIG
         STB,5    S:ACCW+1
         LI,7     1                 ONE RECORD
         BAL,1    RTAPE             READ MON INFO REC
         LB,3     INFOBUF           GET VERSION
         LW,4     INFOBUF,3
         SLD,4    -4
         SLS,4    -12
         SLD,4    4
         LI,5     X'4170'           SYMBIONT, CPV, SIG7
         BIF,S7   KNOWN             ASSUME SIGMA 7 (BIT 25)
         AI,R5    X'4000'           MAKE IT SIGMA 9 (BIT 24)
         BIF,S9   KNOWN             SIGMA 9 IS OK
         AI,R5    X'4000'           MAKE IT X560 (BITS 24 & 25)
KNOWN    EQU      %
         STB,4    5                 SYMB
         SCS,5    -8                UTS
         STW,5    SYSVERS
         LI,5     '
'
         INT,3    INFOBUF           #LINES
         AWM,3    MAXSEG            SET MAX SEG#
         MTW,4    DATCLST
         LI,4     24
         LI,0     DA(DATCLST)
         LC       BOOTFLG           IF NO LP, CANT CHECK DEVICE
         BCR,4    PRNT
         :HIO,0   *LLNDD
         LW,6     LLNDD
         BAL,11   ERROREC
         DATA     3
         :TDV,7   *LLNDD
         AND,7    Y02
         REF      Y02
         BE       %+2
         MTB,-1   LLNDD
         :HIO,0   *LLNDD
PRNT     LC       BOOTFLG           NO LP FLAG
         BCR,4    PRNT1             SAYS NO PRONT
         LW,6     LLNDD
         BGZ      %+3
         BAL,11   ERROREC
         DATA     3
         BAL,11   ERROREC
         DATA     3
PRNT1    EQU      %
         LW,6     DATCLST
         STB,5    0,6
         AWM,4    DATCLST
         AWM,4    DATCLSTT+1
         BDR,3    PRNT
         LI,0     DA(DATCLSTT)
         MTW,4    DATCLSTT
         LC       BOOTFLG           NO OC OF NO FLAG
         BCR,8    %+2               NO OC
         BAL,2    OCMSG
         LI,7     1
         BAL,1    RTAPE             DELTA HEAD
         INT,15   INFOBUF+1         BIAS AND START ADDRESS
         STS,15   DLTBIAS
         AWM,15   BPCH
         SLD,14   2+32              STUFF BUFFER ADDRESS IN
         LI,15    X'7FFFF'          READ COMMANDS
         STS,14   DLTSZ-1           FOR SWAPPER
         STS,14   TREAD             AND TAPE
         LB,7     INFOBUF+4         # OF PAGES TO READ
         BAL,1    RTAPE            CODE
         STW,1    DLTSZ
         LI,14    BA(BUFFER)        NOW SWITCH TO REAL BUFFER ADDRESS
         STS,14   TREAD
         LC       BOOTFLG           CHACK OC FLAG
         BCR,8    NOX2
         LI,0     DA(SSW)           SENSE SWTICH REMINDER
         BAL,2    OCMSG
NOX2     EQU      %
         LI,11    SWAPINIT          FIRST RETURN FROM PATCHING
MAXSEG   LI,2     -11               BECOMES LI,3 MAXSEG
SEGPATCH EQU      %
         MTW,1    SEGNO
         LW,1     SEGNO
BPCH     B        PACHSTRT
PACHSTRT EQU      1
         PAGE
WRTPRT   EQU      %
         LCI      2
         STM,R12  WRTPRTM+6         PUT INTO MESSAGE
         LI,R0    DA(WRTPRTCM)
         B        BADCMN
BADISC   LI,1     '12'
         MTB,0    MB:SWAPS,7
         BEZ      %+2
         LI,1     '32'
BADDP    EQU      %
         STH,R1   BADCM+4           RAD TYPE
         LI,R0    DA(BADC)
         B        BADCMN
BADDPX   EQU      %
         LCI      2
         STM,R12  BADMX+6           PUT INTO MESSAGE
         LI,R0    DA(BADCX)
BADCMN   EQU      %
         BAL,2    OCMSG
         MTW,0    SPECFLG
         BEZ      %+3               CONTINUE
         B        %                 WRITE PROT.DURING OVERLAY COPY
         B        %-1               S T O P   ********
         LB,1     MB:SDI,7
         B        DCINP
BADDP1   EQU      %
         SCD,R12  16
         LCI      2
         STM,R12  BADCM1+4          PUT INTO MESSAGE
         LI,R0    DA(BADC1)
         B        BADCMN
FLAW     EQU      %
         LI,0     DA(FLOD)
         BAL,2    OCMSG
         B        %
         B        CT1
FLD      EQU      %
         AI,2     1
         LB,15    BUF,2
         CI,15    'F'
         BG       %+2
         AI,15    '0'-'A'+10
         AI,15    -'0'
         BLZ      EFLD
         SLS,9    3
         BCS,4    EFLD              TOO MANY CHARS
         SLS,9    1
         AW,9     15
         B        FLD
         USECT    BOOTSUBR          BACK TO DISC BOOT CODE
EFLD     CI,15    ' '-'A'+10
         BLE      *8
EOM      LI,0     DA(QUEST)
MESSG    RES
         BAL,2    OCMSG
         LI,4     0
         STW,4    BUF
         LI,0     DA(IN)
         :SIO,0   *OCNDD
         LW,2     *X'54'
         AI,2     -500*10           WAIT TEN SECS
         LW,3     BUF               OR UNTIL INPUT STARTS
         BNEZ     MESSG1
         CW,2     *X'54'
         BNE      %-3
         :HIO,0   *OCNDD            GIVE UP
         B        *10               RETURN WITH ZERO BYTE COUNT
MESSG1   RES
         :TIO,2   *OCNDD
         BCS,12   :A
         INT,3    3                 GET BYTE COUNT
         LCW,3    3
         BEZ      EOM               TOO MANY
         AI,3     9
         LB,2     BUF,3
         CI,2     8
         BE       EOM
         CI,2     5
         BE       %+3
         CI,2     X'15'
         BNE      EOM
         STB,4    BUF,3             ZERO TERMINATOR
         B        *10
OCMSG    :SIO,0   *OCNDD
         :TIO,0   *OCNDD
         BCS,12   :A
         B        0,2
VALINP   LI,1     1
         LI,3     DCTSIZ
KRD2     CB,2     DCT4,1            DEVELOP DCTX BY TYPE CODE MATCH
         BE       VALINP1           DCTX FOUND
         AI,1     1
         BDR,3    KRD2              SEARCH ALL OF DCT4
         B        %                 ERROR-CANT BOOT
VALINP1  LH,9     DCT1,1            DEVICE ADDRESS
         CI,6     0
         BE       *5                DONT GET NEW
DCINP    LD,10    DCT16,1
         AI,10    X'1500'-X'4000'   BLANK TO NL
COCVAL   STD,10   DEVNOM
         LI,0     DA(DEVNO)
         BAL,10   MESSG             REQUEST NDD
         LI,12    X'FE2C1'          CHARS. 'SA'
         CH,12    BUF
         BE       *5
         LD,12    DCT16,1
         LI,9     X'FFF00'          UPDATE DCT16
         LW,8     BUF
         SLD,8    -8
         STS,8    13
         LB,R8    BUF               GET N
         BAL,R15  CL2PA             CONVERT CHAN LETTER TO PROC ADDR
         BCS,1    EOM               B/ BAD LETTER
         LW,R9    R8                NEED IT IN R9
         AI,R9    1                 TO PLAY WITH IT LATER
         LI,2     0
         BAL,8    FLD               GET DD
         AI,9     -X'100'
         BLZ      EOM
         STD,12   DCT16,1           RESET DCT16
         STH,9    DCT1,1            PUT IN NEW
         STH,9    DCT1A,1
         STH,9    DCT1P,1           OTHER HALF OF JOB
         B        *5
SEGNO    DATA     -1
SEGSIZE  RES      1
YES      DATA,1   'Y','E','S',0
NO       DATA,2   'NO',0
         USECT    BOOTSUBR
         BOUND    8
RESDFCP  GEN,8,24,32 5,BA(RESDFM),25
ALFA     DATA     C'A',C'F'
NUMR     DATA     C'0',C'9'
IN       GEN,8,24,32 X'86',BA(BUF),10
QUEST    GEN,8,24,32 5,BA(QM),4
GDATE    GEN,8,24,32 5,BA(GDATEM),16
GTIME    GEN,8,24,32 5,BA(GTIMEM),13
RDLT     GEN,8,24,32 5,BA(RDLTM),24
DLTCLST  GEN,8,24 3,BA(DLTDSC)      SEEK TO DELTA ON SWAPPER
         DATA     X'2E000004'
         DATA     X'2000000'        READ IT
DLTSZ    DATA     X'2E000000'
         GEN,8,24 3,BA(UMOVSA)      SEEK TO ROOT EXTENSION
         DATA     X'2E000004'
BAUMOV   DATA     X'2023800'        READ IT
UMOVSZ   DATA     0
DLTDSC   DATA     0
UMOVSA   DATA     0
RDLTM    GEN,8,24 X'15','DO '
         TEXT     'YOU WANT DELTA (Y/N)'
GTIMEM   GEN,8,24 X'15','TIM'
         TEXT     'E(HH:MM)='
GDATEM   GEN,8,24 X'15','DAT'
         TEXT     'E(MM/DD/YY)='
QM       DATA,1   ' ','?','?',X'15'
RESDFM   DATA,1   X'15','R','E','S'
RESTRD   TEXT     'ET RESDF YYY,XXXXX ? '
         USECT    TBOOT:
CODES    TEXTC    'DFTCPI'
1STMESM  DATA,1   X'15','E','N','T'
         TEXT     'ER ANY OF:'
         DATA,1   X'15','I','=','T'
         TEXT     'TY I'
         DATA,1   '/','O',X'15','P'
         TEXT     '=LP OUTP'
         DATA,1   'U','T',X'15','F'
         TEXT     '=TAPE FI'
         DATA,1   'L','E','S',X'15'
         TEXT     'T=TAPE PATCH'
         DATA,1   'E','S',X'15','C'
         TEXT     '=CARD PATCHE'
         DATA,1   'S',X'15','D','='
         TEXT     'XDEL'
         DATA,1   'T','A',X'15'
1STMESSZ EQU      BA(%)-BA(1STMESM)
         DEF      ERROREC
         BOUND    4
DFALTM   DATA,1   X'15','C','/','L'
         TEXT     'L/DC ASSIGN OK (YES/NO)'
SSWM     TEXT     '
SET SENSE SWITCHES AND TYPE N/L'
         TEXT     '
SSW1 => CHECKWRITE DISC WRITES'
         TEXT     '
SSW2 => NO AUTOMATIC LOGON/LOGOFF'
         TEXT     '
SSW3 => OPERATOR RECOVERY ON DISC BOOT'
         TEXT     '
SSW4 => SYSTEM SECURITY CHECKING'
SSWMSZ   EQU      BA(%)-BA(SSWM)
BADCM    DATA,1   X'15','S','W','A'
         TEXT     'PPER NOT  72'
         DATA,1   'X','X',X'15'
         BOUND    4
BADMX    DATA,1   X'15','N','O',' '
         TEXT     'RESPONSE FOR SWAPPER  YY'
         DATA,1   'N','D','D',X'15'
         BOUND    4
BADCM1   DATA,1   X'15','D','I','S'
         TEXT     'C PACK BAD  YYND'
         DATA,1   'D',X'15'
         BOUND    4
WRTPRTM  DATA,1   X'15','S','W','A'
         TEXT     'PPER WRITE PROTECTED  YY'
         DATA,1   'N','D','D',X'15'
         BOUND    4
FLAWM    TEXT     ' PSA TRACK FLAW'
         BOUND    8
DEVNOM   TEXT     'XXXYYNDD'
         TEXT     ' => '
BUF      RES      3
ERROREC  EQU      %
         LCI      0
         STM,0    TSAVE
         LW,5     *11               GET CODE
         :SIO,1   *6                DO SIO
         BCS,4    NOSIO             NOGUDNIK
         LC       1                 GET STATUS
         BCR,1    MANUL             MANUAL
WAITLP   EQU      %
         WAIT     0                 WAIT FOR DISC OPERATIONS
WTELOP   :TIO,1   *6
         BCR,8    %+2
         BCS,4    NOPER             NO ADDR RECOG
         SLS,1    2                 SHIFT SOME STATUS BITS A BIT
         BOD      WAITLP            STILL BUSY IF Y4 SHIFTED OFF
         LC       1                 NOW PICK UP SOME
         BCS,1    WAITLP            STILL BUSY IF Y04 WAS SET
         BCS,2    XITTBL,5          UNUSUAL END
         CI,5     2
         BE       %+3               DONT RESET RETRIES IF CHECKWRITE
         LI,2     -11
         STW,2    TRYCOUNT          RESET RETRY COUNT
         LCI      0
         LM,0     TSAVE
         AI,11    1
         B        *11               GOOD RETURN
XITTBL   B        TPREC             0=TAPE
         B        LOGERR            1=CARD READER
         B        RDREC             2=DIXC
         B        PTREC             3=PRINTER
         B        RDREC             4=DISC (CHECKWRITE)
NOSIO    :TIO,1   *6
         BCR,8    %+3
         BCR,4    RTNXIT            BUSY SIOP, RETRY
         B        NOPER             NO ADDR RECOG, WAIT FOR FIXIT
         LB,2     1                 STATUS BYTE
         CI,2     64
         BCS,4    RTNXIT            BUSY DEVICE
         CI,2     32
         BCR,4    RTNXIT            OPERATIONAL
NOPER    LI,1     CDNOP
         BAL,11   MSGWRT            MESSAGE
OPERINV  LW,11    *X'54'            WAIT FOR OPERATOR
         WAIT     0
         CW,11    *X'54'            BUT NOT THE CLOCK
         BNE      OPERINV
         B        RTNXIT            FIXED
TPREC    :TDV,1   *6
         LH,2     1                 STATUS BYTES
         CI,2     X'8820'
         BCS,4    TPNCOR            OVERRUN,UNCOR-READ,IOP MEMORY
         INT,1    1                 IF INCORRECT LENGTH, IGNORE IF 80 BYTES
         CI,1     2048-80
         BE       RTNXIT            AND RETRY
         CI,2     X'40'
         BCR,4    LOGERR            UNRECOVERABLE, TRY AGAIN
         LI,2     32                PARITY ERROR, TRY TO CORRECT
         STB,2    TPCOM1+1          SET CMND CHAIN
TPNCOR   LI,0     DA(TPCOM1)
         :SIO,0   *6
         :TIO,0   *6
         BCS,4    :A
         LI,2     0
         STB,2    TPCOM1+1          RESET
         B        RTNXIT0           RETRY
PTREC    :TDV,1   *6
         LH,2     1                 GET STATUS BYTES
         CI,2     X'2400'
         BCS,4    LOGERR            PAPER LOW OR RUNAWAY
         CI,2     X'4056'
         BCS,4    RTNXIT0           PARITY, RETRY
         B        LOGERR            UNRETRIABLE
RDREC    :TDV,1   *6
         LB,2     1                 STATUS BYTE
         CI,2     X'30'
         BCR,4    RTNXIT0           NOT WRITEPROTECT OR BAD SEEK, RETRY
LOGERR   CI,5     4
         BNE      LOGSTS            NOT CHECKWRITE
         LI,0     DA(TTMSGCK)
         :TIO,0   *OCNDD
         BCS,4    :A
         :SIO,0   *OCNDD
LOGSTS   :TIO,3   *6
         LI,4     MSGTIO
         BAL,11   TPCONV            PUT IN MESSAGE
         :TDV,3   *6                GET TDV STATUS
         LI,4     MSGMNL
         BAL,11   TPCONV            PUT IN MESSAGE
         LI,1     CDMSGER
         BAL,11   MSGWRT            TYPE MESSAGE
         LI,1     -12
         STW,1    TRYCOUNT          RESET RETRY COUNT
         B        OPERINV           WAIT FOR OPERATOR
RTNXIT0  MTW,1    TRYCOUNT
         BGEZ     LOGERR            NO MORE RETRIES
RTNXIT   STW,5    COMRET            SAVE CODE
         LCI      0
         LM,0     TSAVE
         AI,11    1
         XW,11    COMRET
         CI,11    4
         BE       *COMRET           CHECKWRITE, GO BACK TO WRITE
         MTW,-2   COMRET
         B        *COMRET           GO BACK TO SIO
MANUL    LI,1     CDMSGMNL
         BAL,11   MSGWRT
MANUL1   EQU      %
         :TIO,1   *6                WAIT
         LB,2     1                 UNTIL
         CI,2     16                AUTO
         BAZ      MANUL1            THEN
         B        WTELOP            GO TO WAIT LOOP
TPCONV   LI,1     -8                8 HEX CHARS
         LI,2     0
         SLD,2    4                 GET ONE
         CI,2     9
         BLE      %+2
         AI,2     'A'-'0'-10        ALPHA
         AI,2     '0'
         STB,2    *4,1              PTU IN MESSAGE
         BIR,1    TPCONV+1
         B        *11
MSGWRT   LW,0     1
         SLS,0    -1                DA(CLIST)
         LW,1     *1                BA(MSG)
         SLS,1    -1                HA(MSG)
         LH,2     DEVCODE,5         GET YY
         STH,2    1,1               PUT IN MESSAGE
         :SIO,0   *OCNDD
         BCS,12   :A
         B        *11
CKWRTMDG TEXT     '
!! CHECK-WRITE ERROR'
MSGNOP   TEXT     '

!!   INOPERATIVE'
MSGER    TEXT     '

!!   ERROR.  TIO          '
MSGTIO   TEXT     '   TDV          '
MSGMNL   TEXT     '

!!   MANUAL MODE'
DEVCODE  TEXT     'MTCRDCLPDC  '
SWAPINIT EQU      %                 RETURN FROM XDELTA, 1ST NON-RES.PATCH
         MTW,0    :ENDFND
         BNEZ     RECNFDON    YES-- WAS :END COMMAND ENCOUNTERED
         MTW,1    :ENDFND     NO--- SET TO FOUND BY DEFAULT
         BAL,R15  RECNFG:2    ****  ASSUME :END BY DEFAULT
RECNFDON EQU      %
         LI,R2    JITLOC
         LI,1     512*4
         BAL,10   WDISC
         LB,0     MB:SDI
         LW,8     S:DP
         BEZ      SWPI1
         LCW,8    S:CYLSZ
         AWM,8    #PAGES
         LI,8     8                 ACAT'S DATA BEGINS AT SEC 8
         STH,0    8
         BAL,11   DSCCVT
         STW,8    DISCLOC
         LW,3     8
SWPI1    EQU      %
         LI,4     MAXOVLY+4         INDEX FOR ALLOCAT
         LI,7     1                 NUMBER OF RECORDS TO READ.
HEAD     EQU      JITLOC
BUFFER   EQU      JITLOC+512
RHEAD    BAL,15   GETHEAD           READ AND MOVE HEAD RECORD
         CI,4     MAXOVLY+1         IS IT TIME TO SKIP TO OVERLAYS
         BNE      PARSHEAD
         AI,4     -2                YES
PARSHEAD EQU    %
         LI,1     X'1FFFF'
         LW,0     HEAD+1            GET START ADDRESS
         STS,0    P:SA,4
         LH,0     HEAD+2            GET TCB ADDRESS FOR FIX
         SLS,0    1
         STS,0    P:TCB,4
         LB,0     HEAD+3            DATA SIZE
         STB,0    PB:DSZ,4
         LB,7     HEAD+6            DCB SIZE
         STB,7    PB:DCBSZ,4        SAVE IT
         AW,7     0                 ASSURE SPACE ON CYLINDER
         BAL,10   SIZCHK
         LW,0     HEAD+4            PRCD WORD
         SLS,0    -8
         STB,0    PB:PVA,4          BIAS
         AH,0     0                 ADD SIZE
         STB,0    PB:HVA,4
         LB,0     HEAD+4            SIZE
         STB,0    PB:PSZ,4
         LH,7     3
         BEZ      %+2
         STB,7    PB:DC#,4
         STH,3    PH:DDA,4          DATA DISC ADDRESS
         LB,7     PB:DSZ,4
         BEZ      NOTGHOST          NO DATA
         BAL,1    RTAPE             READ DATA RECORD
         LW,0     X'2A'             IS THIS BOOT UNDER FILES
         AW,0     SEGNO             IS THIS ALLOCAT'S DATA
         BGZ      PWDATA            NO, OR NOT UNDER FILES
         LI,10    X'80'             YES, READ BUT NOWRITE DATA
         STH,10   WRCOM             CHANGE  WRITE TO READ TO INCR DA
         LW,7     DISCLOC           SAVE DISC ADDRESS
         LI,2     BUFFER            SET BUFFER ADDRESS
         BAL,10   WDISC             READ ALLOCAT DATA FOR PATCHING
         STW,7    DISCLOC
         LI,10    X'40'             RESTORE WRITE COMMAND
         STH,10   WRCOM
PWDATA   LW,3     HEAD+3            DATA BIAS
         BAL,10   RWDSK+1           WRITE DATA RECORD..
NOTGHOST EQU      %
         LB,7     PB:DCBSZ,4
         BEZ      %+3               NO DCBS
         LW,3     HEAD+6            DCB BIAS
         BAL,10   RWDSK             READ WRITE DCBS
         LB,7     PB:PSZ,4          ASSURE SPZCE ON CYL
         BAL,10   SIZCHK
         LH,10    3
         BEZ      %+2
         STB,10   PB:C#,4
         STH,3    PH:PDA,4
         LI,10    JJITVP+1
         CB,10    PB:PVA,4          IF NOT OVERLAY
         BNE      NOTUMOV
         STW,3    UMOVSA            SAVE UMOV'S D.A.
         SLS,7    11                AND SIZE
         STW,7    UMOVSZ
         SLS,7    -11
         AWM,4    UMOV#
NOTUMOV  RES
         LW,3     HEAD+4            PROCEDURE BIAS..
         BAL,10   RWDSK             READ WRITE PROCEDURE
         BDR,4    RHEAD
RECOV    BAL,15   GETHEAD
         LW,1     HEAD+1            START ADDRESS
         STW,1    RCVSTART+1
         LB,7     HEAD+4            # RECORDS
         BAL,10   SIZCHK
         STH,3    PH:PDA            SET END OV LAST OVERLAY FOR DRSP
         LH,3     3                 AND ITS C#
         BEZ      %+2               IF THERE IS ONE
         STB,3    PB:C#
         LW,3     DISCLOC
         STW,3    RCVDISC           SET DISC ADDRESS
         LW,3     HEAD+4            RECOVERY PROCEDURE BIAS...
         BAL,10   RWDSK             READ WRITE RECOVER
         STW,1    RCVSIZE
         LI,2     X'1FFFF'
         AND,2    DLTBIAS
         INT,7    DLTSZ
         SLS,7    -11
         BAL,10   SIZCHK
         LW,3     DISCLOC           SET DISC ADDRESS
         STW,3    DLTDSC
         INT,1    DLTSZ
         BAL,10   WDISC
         REF      GETHGP,MONCHK
         LI,2     TOPROOT-GETHGP
         LW,7     GETHGP
         AW,7     GETHGP,2
         BDR,2    %-1
         STW,7    MONCHK
         LI,2     PPTABLE           FOR RESDF PAGES RECOVERY
         BEZ      SWAPRTN           NONE
         LI,7     1                 GET 1 GRANUAL
         BAL,10   SIZCHK
         LW,3     DISCLOC
         STW,3    PPTABDSK          SAVE DISC ADDRESS
         LI,1     PPTABLSZ
         SLS,1    2                 BYTE SIZE
         BAL,10   WDISC             WRITE OUT NULL TABLE
         BAL,11   SEEKCVT
         STW,8    PPTABDSK2         FOR RECOVERY
SWAPRTN  B        WRTROOT
GETHEAD  LI,7     -2048             SET HEAD BUFFER ADDRESS
         AWM,7    TREAD
         BAL,1    RTAPE
         AWM,13   TREAD             13 COMES BACK WITH 2048 IN IT
         LW,7     HEAD+7            SET SIZE IN XDELTA
         SLS,7    -2                IN WORDS
         LI,2     4                 IN WORD 4
         STW,7    *DLTBIAS,2
         B        *15
RTAPE    LW,12    TREAD             SAVE BUFF ADDR
         LI,13    2048              ADDR INCREMENT
RTAPE1   LI,0     DA(TREAD)
         LW,6     37
         BAL,11   ERROREC
         DATA     0
         AWM,13   TREAD
         BDR,7    RTAPE1
         XW,12    TREAD
         SW,12    TREAD
         XW,12    1
         B        *12
SIZCHK   MTW,0    S:DP              ASSURE (7) PAGES LEFT ON CYL
         BEZ      *10               IF DP SWAPPER
         AWM,7    #PAGES
         BLEZ     *10               O.K.
         LCW,3    S:CYLSZ           NO, SKIP TO NEXT
         STW,3    #PAGES
         MTH,1    DISCLOC           INCR CYL#
         LH,3     DISCLOC           CLEAR TRACK/SECTOR
         SLS,3    16
         STW,3    DISCLOC
         B        SIZCHK            AND TRY AGAIN
#PAGES   DATA     4                 START WITH FIRAT 8 SECTORS GONE
RWDSK    BAL,1    RTAPE             READ
         STW,1    SEGSIZE
         LI,2     BUFFER            SET BUFFER ADDRESS
         LH,6     3                 GET SIZE OF SEG
         INT,3    3                 AND BIAS
         SLS,3    1
         SLS,6    1                 BOTH IN WORDS
         BAL,11   SEGPATCH          SET SEGNO AND PATCH
         LW,1     SEGSIZE
WDISC    LD,12    WRCOM             GET WRITE COMMAND
         AW,12    2                 SET BUF ADDR
         SLS,12   2                 BYTE ARRD
         LW,14    1
GRANBND  LI,3     X'7FF'
         LS,3     14
         BEZ      %+4               EVEN # SECTORS+0
         CI,3     X'400'
         BG       %+2               ODD # +PART
         AI,14    X'400'            EVEN+PART OR ODD+0
         LI,3     1
         AI,14    -1
GCLST    AI,14    1-X'10000'
         BGEZ     %+3
         AW,13    14
         AI,13    X'10000'
         STD,12   CLIST,3           STORE IN CLIST
         AI,12    X'10000'          ADJUST BUFFER ADDRESS
         AI,3     1
         BDR,14   GCLST
         LD,12    SENSE
         STD,12   CLIST,3           PUT SENSE AFTER WRITES
         LI,0     DA(CLIST)
         LW,6     M:SWAPD
         BAL,11   ERROREC
         DATA     2
         SLS,3    3
         AI,3     -8
         LI,11    5                 CHECKWRITE CODE
         STB,11   CLIST,3           PUT CHECKWRITES IN
         AI,3     -7
         BDR,3    %-2
         BAL,11   ERROREC
         DATA     4
         BCS,4    WDISC             TRY AGAIN IF BAD
NOCHKWRT LW,3     SENSW
         BGEZ     ALLSOK
         MTW,1    SPECFLG           SET STOP FLAG
         LB,R1    MB:SDI            GET SWAPPER DCT INDEX
         LD,R12   DCT16,R1          GET YYNDD
         SLD,R12  8
         AI,R12   X'15'
         B        WRTPRT
ALLSOK   EQU      %
         STW,3    DISCLOC           UPDATE DISCLOC
         MTW,0    S:DP
         BNEZ     %+2
         LH,3     3
         B        *10
DISCLOC  DATA     X'4A'**16
SENSW    TEXT     'NOPE'
         RES      3                 USED BY SENSE
SPECFLG  DATA     0                 =0, SWAPPER TESTING MODE
*                                   >0, TAPE TO SWAPPER MODE
         PAGE
WRTROOT  EQU      %
BB       SET      0
         DO       BB
         REF      SL:BB,C:SCOB
         LI,2     3700              INITIALIZE
         LI,3     37                BATCH BIAS
         MW,3     SL:BB             TABLE
         SW,2     3
         STH,2    3
         LW,1     3
         MW,1     C:SCOB
         LCW,1    1
         LW,2     C:SCOB
         AW,1     3
         STW,1    C:SCOB,2
         BDR,2    %-2
         FIN
         LW,3     DISCLOC
         LI,7     32                GET 16K FOR FIRST PART OF MONITOR
         BAL,10   SIZCHK
         STW,3    DABOOT            SET DA
         LI,4     MONIRTN+X'1FF'-X'4000' SIZE OF PARTS 2 AND 3
         SLS,4    -9                IN PAGES
         AI,4     -32
         BGZ      %+2               BOTH NECESSARY
         AW,7     4                 NO, ONLY WRITE ONE
         LI,2     0                 BA FIRST PART
         LI,3     X'2000'           TURN OFF THE CLOCK
         WD,3     X'1100'           SO THE CHECK WRITE WORKS
         LI,1     32*2048           SIZE
         BAL,10   WDISC
         LI,3     X'2000'           TURN IT BACK ON
         WD,3     X'1200'
         LI,2     32*512            BA SECOND PART
         LW,3     DISCLOC
         BAL,10   SIZCHK            WHERE DOES IT GO
         STW,3    DABOOT+1          THERE
         REF      MPPSEEK
         STW,3    MPPSEEK           ALSO WHERE RECOVER OVERLAY STARTS
         AI,4     0                 ARE WE DOING TWO OR THREE
         BLEZ     WRTM2             ONLY 2
         LI,1     32*2048           THREE, SIZE OF FULL PIECE
         BAL,10   WDISC             WRITE IT
         LW,7     4                 FIND SPACE FOR PART THREE
         LW,3     DISCLOC
         BAL,10   SIZCHK
         STW,3    DABOOT+2          SET DA
         LI,2     64*512            BA THORD PART
WRTM2    LW,1     7                 SIZE OF LAST PART (2 OR 3)
         SLS,1    11
         BAL,10   WDISC
         BAL,11   SEEKCVT           CALCULATE RCVRAD
         STW,8    RCVRAD
         LW,3     DABOOT            PREPARE TO WRITE FIRST PARET
         STW,3    DISCLOC
         AI,R8    X'44'
         BAL,R11  DSCCVT
         STW,R8   SEEK4000          SEEK OF X'4000'
         LI,R2    X'5A'             WRITE OUT MONITOR FROM HERE
         LI,6     BA(MONIRTN)       LAST NECESSARY WORD TO WRITE
         LW,7     X2000FFFF         SET BOOTIC TO STOP READING THERE
         STS,6    7+BOOTIC          MEBBE THIRD CDWD
         CI,6     X'8000'*4
         BG       %+2               YUP
         STS,6    3+BOOTIC          NO, TERMINATE AT SECOND
         LI,1     32*X'800'
         BAL,10   WDISC             WRITE 1ST 16 K
*  WRITE DISC BOOT
         LI,1     2048
         LI,2     DBOOT
         LI,4     0
         STW,4    DISCLOC
         BAL,10   WDISC
         B        GMONEX
         USECT    BOOTSUBR
PUTRT    LW,0     RTICBHDR          IS THIS REALITME SYSTEM
         BLZ      *MONIRTN          NO
         LC       X'2A'             IS THIS RECOVERY
         BCS,15   PUTRT2-1          NO
*
* READ PPTABLE
*
PUTRT1   LI,0     DA(RDPPTAB)
         BAL,4    SWAPREAD
         LI,5     PPTABLSZ
PUTRT2   LW,1     PPTABLE-1,5       GET ENTRY
         BEZ      PUTRT7            UNUSED
         LI,0     0
         SLD,0    16                R0=1ST PAGE
         SLS,1    -16               R1=# OF PAGES
         LW,8     1                 # PAGES
         AW,1     0
         AI,1     -1                LAST PAGE
*
* GET THE PAGES OUT OF M:FPP CHAIN
*
         LW,3     M:FPPH
PUTRT3   CI,3     0                 IS THIS THE END OF MX:PPUT
         BE       PUTRT8            YES-ERROR
         LOAD,6   MX:PPUT,3         FOR FORWARD LINK
         CLR,0    3                 IS THIS A RESDF PAGE
         BCR,6    PUTRT4            YES
         LW,4     3                 SAVE BACKWARD LINK
         LW,3     6                 GET NEXT IN CHAIN
         BNEZ     PUTRT3
         B        PUTRT8            BAD ENTRY
*
PUTRT4   CW,3     M:FPPH            IS RESDF PAGE PPUT HEAD
         BNE      PUTRT5            NO
         STW,6    M:FPPH            AND SET NEW PPUT HEAD
         B        PUTRT6
*
PUTRT5   STORE,6  MX:PPUT,4         LINKED TO BACKWARD LINK
         BNEZ     PUTRT6            NOT RELEASING TAIL
         STW,4    M:FPPT            BACKWARD LINK IS NOW TAIL
*
PUTRT6   MTW,-1   M:FPPC
* PUT THE PAGES IN PP:UPP CHAIN
*
         LI,2     0
         STORE,2  MX:PPUT,3         NEW PP:UPP TAIL
         LW,2     PP:UPPT           DO I ALREADY HAVE A TAIL
         BNEZ     %+3               YES-NOT 1ST IN CHAIN
         STW,3    PP:UPPH           INITIALIZE HEAD
         B        %+2               NOTHING TO LINK
         STORE,3  MX:PPUT,2         LINK TO PREVIOUS TAIL
         STW,3    PP:UPPT           SET NEW TAIL
         MTW,1    PP:UPPC           COUNT THEM UP
         LW,3     6                 GET NEXT IN PPUT CHAIN
         BDR,8    PUTRT3            GET ALL PAGES IN THIS SET
PUTRT7   BDR,5    PUTRT2            LOOK AT ALL ENTRIES IN TABLE
         LCW,5    RESDF             ADJUST VALUES FOR THE PAGES
         AWM,5    S:ACORE            WE TOOK AWAY
         AWM,5    S:PCORE
         LCW,5    DYNRESDF
         AWM,5    S:ACORE
         LCW,5    MDYNRESDF
         AWM,5    S:PCORE
         B        *MONIRTN          ALL DONE
*
PUTRT8   LI,0     0                 ZAP BAD ENTRY
         STW,0    PPTABLE-1,5
         B        PUTRT7
*
ERRMSK   DATA     X'700000'
*
         DEF      OCNDDFLG
OCNDDFLG DATA     0                 =0, NO OC ADDR.CHANGE
*                                   >0, OC ADDR.CHANGED,VALUE=DCT INDEX
MPBR     B        SYSTRT            FOR MP AND OTHER SYSTEMS
         USECT    TBOOT:
X2000FFFF DATA    X'2000FFFF'
TRYCOUNT DATA     -11
COMRET   RES      1
TSAVE    RES      16
         USECT    BOOTSUBR
NSIG7XPSD XPSD,10  NSIG7PSD
NSIG7TRP LI,R1    X'40'             ASSUME SIGMA 9
         LI,R2    0                 CLEAR OUT R2
         LCFI     0                 CLEAR FLOATING CONTROLS
         LPSD,1   X560PSD           TRY TO SET FR BIT
X560CHK  STCF     R2                STORE IT
         CI,R2    0                 TEST IT
         BEZ      ITSA9             B/ MUST BE SIGMA 9, FR NOT SET
         LI,R1    X'20'             MUST BE XEROX 560
ITSA9    MTW,1    NSIG7PSD          BUMP UP IA
         LPSD,1   NSIG7PSD          RETURN
         USECT    TBOOT:
*
*   ROUTINE TO CONVERT A CHANNEL LETTER IN R8 TO A
*   PROCESSOR ADDRESS USING STANDARD SIGMA (A=1,B=2...ETC.) OR
*   XEROX 560 CONVERSION. RESULT RETURNED IN R8 RIGHT JUSTIFIED
*   CC4=0 IF LETTER IS OK, CC4=1 IF LETTER INVALID
*   USES R3, LINK IS R15
*
         DEF      CL2PA
CL2PA    EQU      %
         BIF,X560 CUCLCVT           USE X560 TABLE
         AI,R8    -'A'
         BLZ      BADLETTER
         CI,R8    7
         BG       BADLETTER         ALLOW ONLY A-H
GOODLETTER  EQU  %
         LCI      0
         B        *R15              RETURN
BADLETTER  EQU  %
         LCI      1
         B        *R15
CUCLCVT  EQU  %   CONVERSION FOR X560
         LI,R3    0
CUCLOOP  CB,R8    X560CUCL,R3       LOOK FOR MATCH
         BE       GOTN              GOT IT
         AI,R3    1                 NO, CONTINUE
         CI,R3    X560CUCLL         SIZE OF TABLE
         BLE      CUCLOOP           TRY NEXT
         B        BADLETTER         NOT IN TABLE, GRIPE
GOTN     LW,R8    R3                INDEX IS THE PROC ADDRESS
         B        GOODLETTER
*
*   VECTOR OF CHANNEL LETTERS INDEXED BY X560 IOP ADDRESS
*
         DEF      X560CUCL,X560CUCLL
X560CUCL DATA,1   'A','%','#','@',':',0,0,0,;
                  'B','C','D','E','F','G',0,0,;
                  'H','I','J','K','L','M',0,0,;
                  'N','O','P','Q','R','S',0,0,;
                  'T','U','V','W','X','Y',0,0,;
                  'Z','0','1','2','3','4',0,0,;
                  '5','6','7','8','9',''
X560CUCLL  EQU  BA(%)-BA(X560CUCL)-1
         USECT    BOOTSUBR
NSIG7PSD :PSD     (IA,NSIG7TRP),RES
X560PSD  :PSD     (IA,X560CHK),(CC,0),FR
*
         USECT    TBOOT:
         BOUND    8
1STMES   GEN,8,24,32 5,BA(1STMESM),1STMESSZ
JCLIST   GEN,8,24,8,24  3,BA(JH:DA),X'2E',2
         GEN,8,24,8,4,20  2,0,X'2C',8,2048
DFALT    GEN,8,24,32  5,BA(DFALTM),28
BADC     GEN,8,24,32  5,BA(BADCM),19
BADCX    GEN,8,24,32  5,BA(BADMX),32
BADC1    GEN,8,24,32  5,BA(BADCM1),22
WRTPRTCM GEN,8,24,32  5,BA(WRTPRTM),32
FLOD     GEN,8,24,32  5,BA(FLAWM),15
DEVNO    GEN,8,24     5,BA(DEVNOM)+2
         PZE          *10           DATA CHAIN
         DATA         BA(DEVNOM)+3,2
SSW      GEN,8,24,32  5,BA(SSWM),SSWMSZ+1**29
         GEN,8,24,32  X'86',BA(BUF),1
DATCLST  GEN,8,24,32 5,4*INFOBUF,24
DATCLSTT GEN,8,24,32 5,4*INFOBUF,0   SIZE STORED IN
TREAD    GEN,8,24,32 2,4*INFOBUF,X'8000800'
INFOBUF  EQU      X'F000'
CDNOP    GEN,8,24,32  5,BA(MSGNOP),18
CDMSGMNL GEN,8,24,32  5,BA(MSGMNL),20
CDMSGER  GEN,8,24,32  5,BA(MSGER),44
TTMSGCK  GEN,8,24,32  5,BA(CKWRTMDG),21
TPCOM1   GEN,8,24,32  75,BA(TPCOM1),1
         GEN,8,24,32  4,BA(SENSW),1**29+1
         GEN,8,24,32  3,BA(SENSW),1
CMND     COM,8,22,10,24 AF(1),AF(2),X'2E'-AFA(1)*32,AF(3)
WRCOM    CMND     0,1**20,0         ADDR,SIZE SET-SHIFTED BY WDISC
SENSE    GEN,8,24,32  4,BA(SENSW),4+X'5E'**24
CLIST    GEN,8,24,8,24 3,BA(DISCLOC),46,4
         GEN,8,24 2,0
         GEN,8,24 X'2F',X'2000'
         GEN,8,24 8,DA(SENSE)
         RES      7
*
         BOUND    8
CMD      EQU      %
  GEN,8,24,8,24   3,BA(SEEK),X'2E',4
  GEN,8,24,32     4,BA(SENSW),16+X'2E'**24
 GEN,8,24,8,24    10,4*INFOBUF,X'1C',0
SEEK     RES      1
*
         USECT    BOOTSUBR
MONIRTN  RES      1
         USECT    TBOOT:
         PAGE
*****************
*  RECONFIGURATION MESSAGES, DATA, VECTORS, & IOCDWS
********
         SPACE    3
*  EXTERNAL REFERENCES    FOR ENTRY POINTS INTO RECNFIG
         REF      RECNFG:0          INITIALIZE DCTS
         REF      RECNFG:1          PROCESS ':' COMMAND
         REF      RECNFG:2          ASSUME :END BY DEFAULT
********
*  RECONFIGURATION FLAGS
         DEF      :ENDFND           USED IN RECNFIG
:ENDFND  DATA     0                 =0, NO :END COMMAND
*                                   >0, :END FOUND
MSG:OUT  DATA     0                 =0, BAD CARD MESSAGE NOT OUTPUT
*                                   >0, BAD CARD MESSAGE HAS BEEN OUTPUT
********
*  I/O COMMANDS
         BOUND    8
BAD:CRD  EQU      %
         GEN,8,24 X'05',BA(:CRD)
         DATA     :CRDSZ
****
         BOUND    8
:CMND    EQU      %
         GEN,8,24 X'05',BA(CCBUF)
         DATA     80
********
*  MESSAGES
:CRD     EQU      %
         DATA,1   X'15'
         DATA,15  '** '':'' COMMAND '
         DATA,13  'NOT IN PATCH '
         DATA,13  'DECK PROPERLY'
         DATA,1   X'15'
:CRDSZ   EQU      BA(%)-BA(:CRD)
         BOUND    4
********
CCBUF    DATA,1   ' '
         DATA,3   0
         RES      20                TEMP.CARD IMAGE BUFFER
********
         BOUND    8
MVECRD   EQU      %
         GEN,8,24 0,0               ADDR.SUPPLIED
         GEN,8,24 80,BA(CCBUF)+1
********
*----------------
         PAGE
*****************
*  RECONFIGURATION INTERFACE ROUTINES
********
         SPACE    3
*****************
*  RECNFG ROUTINE
*
*     ENTERED FROM XDELTA WHEN A ':' COMMAND IS READ
*
*     ENTRY:
*        R12 =    WA(CARD IMAGE BUFFER)
*        R15 =    RETURN ADDRESS INTO XDELTA
*
*     CALLED:
*        R15 =    LINK
*
*****************
         SPACE    3
         DEF      RECNFG            USED BY XDELTA
RECNFG   EQU      %           <---  ENTER
         LW,R13   M24
         SLS,R12  2                 PUT COMMANDS
         STS,R12  MVECRD              ADDR.INTO IOCDW
         SLS,R12  -2                MAKE WORD ADDR.AGAIN
         LD,R6    MVECRD
         MBS,R6   0                 XDELTA'S CARD IMAGE TO TEMP.BUFFER
         LI,R0    DA(:CMND)
         BAL,R10  RECNFGLL    ****  DISPLAY CARD IMAGE ON LL
         MTW,0    SEGNO             IF SEGNO = 0, ':' CARD IS PROCESSED
         BEZ      RECNFG:1    ****  PROCESS ':' COMMAND IN RECNFIG
*
*  RETURN FROM RECNFIG IS DIRECTLY INTO XDELTA
*
*        SEGNO > 0, ':' CARD NOT ACCEPTABLE AS RECNFIG IS
*        COMPLETED & RECNFIG PROCESSOR NO LONGER EXISTS
*
         MTW,0    MSG:OUT
         BNEZ     *R15   ---> YES-- RETURN TO XDELTA IF MESSAGE OUTPUTED
         MTW,1    MSG:OUT     NO--- SET FLAG & OUTPUT MESSAGE
         LI,R0    DA(BAD:CRD)
         BAL,R10  RECNFGOC    ****  MESSAGE TO OC
         LI,R10   '*'
         STB,R10  :CRD              CHANGE NL TO *
         MTW,-1   BAD:CRD+1         MESSAGE SIZE -1, NO NL AT END
         BAL,R10  RECNFGLL    ****  MESSAGE TO LL
         B        *R15        --->  RETURN TO XDELTA
*----------------
         PAGE
*****************
*  RECNFGOC ROUTINE
*
*     OUTPUT MESSAGE TO OC
*
*     ENTRY:
*        R0 =     DA(IOCDW)
*
*     CALLED;
*        R10 =    LINK
*
*****************
         SPACE    3
         DEF      RECNFGOC          USED BY RECNFIG
RECNFGOC EQU      %           <---  ENTER
         :SIO,0   *OCNDD      IIOO
WAITOCX  EQU      %
         :TIO,0   *OCNDD      IIOO
         BCS,12   WAITOCX           WAIT TILL DONE
         B        *R10        --->  RETURN
*----------------
         PAGE
*****************
*  RECNFGLL ROUTINE
*
*     OUTPUT MESSAGE TO LL IF LISTING REQUESTED
*
*     ENTRY:
*        R0 =     DA(IOCDW)
*
*     CALLED:
*        R10 =    LINK
*
*****************
         SPACE    3
         DEF      RECNFGLL          USED BY RECNFIG
RECNFGLL EQU      %           <---  ENTER
         LC       BOOTFLG
         BCR,4    *R10        --->  RETURN, LISTING NOT DESIRED
         LW,R6    LLNDD
         BGZ      NOTLOSPD    NO--- LOW SPEED PRINTER
*                             YES-- DO 2 I/O'S
         BAL,R11  ERROREC     ****  DO I/O
         DATA     3
NOTLOSPD EQU      %
         BAL,R11  ERROREC     ****  DO I/O
         DATA     3
         B        *R10        --->  RETURN
*----------------
         PAGE
         DEF      CANTRUN
CANTRUN  EQU  %
         LI,R1    BA(S7MSG)
         BIF,S7   GRIPE
         LI,R1    BA(S9MSG)
         BIF,S9   GRIPE
         LI,R1    BA(X560MSG)
GRIPE    STW,R1   WRNGMACH+2
         LI,R0    DA(WRNGMACH)
         SIO,0    *OCNDD
         WAIT
         B        %-1
*
         BOUND    8
WRNGMACH  GEN,8,24  5,BA(CANTMSG)
         PZE      *26               DATA CHAIN,BYTE COUNT
         DATA     0                  BYTE ADDRESS OF MSG (FILLED IN)
         DATA     9                 BYTE COUNT
CANTMSG  DATA,2   X'1515','SY'
         TEXT     'STEM NOT SYSGENED FOR '
S7MSG    TEXT     'SIGMA 6  '
S9MSG    TEXT     'SIGMA 9  '
X560MSG  TEXT     'XEROX 560'
         PAGE
*
*        CONVERT DISC ADR TO RELATIVE SECTOR NUMBER
*  I 8  = DCT INDEX IN BYTE0  DISC ADR IN REST
*  O 8  = RELATIVE SECTOR NUMBER
*
*
*   REAL SEEK ADR. TO RELATIVE SECTOR
*
*         (**=DOUBLE REGISTER SHIFT) REAL SEEK=CYL.TRK.SEC
*   DISK PACK:|(CYL.TRK.SEC)**(32-CYL%SHFT)~*NSPC
*         + |(TRK.SEC)**(CYL%SHFT-TRK%SHFT)~*NSPT
*                   + |(SEC)**(TRK%SHFT-SEC%SHFT)~
*
*   RAD: |(TRK.SEC)**(48-TRK%SHFT)~*NSPT
*         + |(SEC)**(TRK%SHFT-SEC%SHFT)~
*
*
SEEKCVT  EQU      %
         LB,R4    MB:SDI            R4=DCT INDEX
         LCI      6
         STM,2    TSAVE             SAVE REGS
         LB,R4    DCT22,R4          R4=SUBTYPE TABLE INDEX
         AND,R3   M24               CYL# RESTRICTED TO 0-255
         LI,R2    0
         LI,R5    32                R5=SHIFT OFFSET FOR DISK PACK
         MTW,0    NCYL,R4           CK CYL ALLOCATED DEV.
         BNEZ     CYL%CVT           YES PACK SPECIFIED
         LI,R6    48                R6=SHIFT OFFSET FOR RAD
         B        TRK%SEEK%CVT
CYL%CVT  EQU      %
         LI,R6    X'7F'
         AND,R6   CYL%SHFT,R4       GET CYL SHIFT FACTOR IN R6
         SW,R5    R6                R5=CYL SIZE
         SLD,R2   0,R5              R2=CYL # RIGHT JUSTIFIED
TRK%SEEK%CVT EQU  %
         LW,R7    R2                MOVE CYL # TO R7
         MW,R7    NSPC,R4           CYL # * NSPC
         LI,R2    0
         LI,R5    X'7F'
         AND,R5   TRK%SHFT,R4       GET TRK SHFT FACTOR
         SW,R6    R5
         SCD,R2   32,R6             R3=TRACK ADDR.
         LI,R6    X'7F'
         AND,R6   SEC%SHFT,R4       GET SECTOR SHIFT FACTOR
         SW,R5    R6
         SCS,R2   0,R5              MOVE SECTOR TO R2
         AW,R7    R2                CYL*NSPC+SEC
         MW,R3    NSPT,R4           TRK*NSPT
         AW,R7    R3                R7=RELATIVE SECTOR #
         LW,R8    R7                MOVE REL.SEC.# TO R8
         LCI      6
         LM,2     TSAVE             RESTORE REGS
         STH,4    8                 PUT DCTX IN FINAL RESULT
         B        *11               RETURN
*
DBOOT    EQU      %
A        ASECT
         ORG      DBOOT
         LOC      A+X'2A'
BOOTS    RD,0     0
         BCR,2    BOOTENT           B/NOT OPERATOR RECOVERY
         SCREECH  -1                GO TO RECOVERY
BOOTENT  EQU      %
         LI,0     DA(DCDW)
         SIO,0    *37
         TIO,0    *37
         LI,0     15000
         BDR,0    %
         BCS,12   %-3
         B        *X'5F'
DABOOT   EQU      %-BOOTS+DBOOT
ROOTSA   DATA     0,0
         DATA     0                 FOR OVFLWED MONITOR
         BOUND    8
DCDW     CMND     3,ROOTSA,4        SEEK
         CMND     2,X'5A',0         READ
         GEN,8,24   8,DA(BOOTIC)    TIC TO  CMMND DBLWD IN TABLES
*                                   BETTER BE IN 1ST 16K
         RES      22-(%-BOOTS)
         LOC      0
         B        START,5
CLOCK    MTW,4    CLOKR
START    LW,2     CLOCK,5
         STW,2    X'55'
         LW,0     CLOKR
         LI,2     X'1000'
         WD,2     X'1200'
         CW,0     CLOKR
         BE       %-1,5
         LCI      0
         LM,0     REGS,5
         B        2
REGS     EQU      %
         LOC      0
         RES      2
         LI,1     511
INTR     INT,14   COCBUF,1
         AND,14   2
         AND,15   2
         LW,0     15
         WD,0     X'42'
         BDR,0    %
CLOKR    B        %-3
         MTW,-4   CLOKR
         BDR,14   %-3
         BDR,1    INTR
         B        2
         END

