START
* THIS PROGRAM WRITES ALL CORE TO A DUMP TAPE. THE TAPE CONSISTS
* OF LABEL,TAPEMARK,24 BYTE IPL BLOCK,MORE CWWS,PROGRAM THEN DATA BLOCKS
START    DS    0D
         DC    A(BOTTOM-START)
         DC    A(IPL-START)
         DC    A(PROGRAM-START)
         DC    A(LDATA-START)
BLOCKS   EQU   254                     NO OF COREPAGES-2
* THIS IS THE FIRST 24 BYTE IPL BLOCK
IPL      DS     0D
         DC    F'4096'
         DC    F'0'                    P-COUNTER AND ISR
         CCW   5,24,X'40',44           READ CHAINED COMMANDS
         CCW   5,4096,X'70',0          SKIP PROGRAM BLOCK
* THIS IS THE SECOND BLOCK
         CCW   3,0,X'40',4096          WRITE FIRST BLOSC
         CCW   3,4096,X'40',4096       WRITE SECOND BLOCK
         CCW   2,4096,X'70',0          SKIP BACK 1 BLOCK
         CCW   2,4096,X'70',0          SKIP BACK ANOTHER BLOCK
         CCW   2,LPL+4095,X'20',LPL          BACKWARDS READ PROGRAM BLK
*         CCW   2,LPL+4095,X'20',X'B50'
         DC    X'FFFBFFFF'             TIMER MASK
         DS    0D
* THIS IS THE PROGRAM BLOCK
PROGRAM  N     8,64(0)                 KNOCK TIMER OUT OF IFR
         ST    7,4(0)                  SAVE P3 GR7
         BALR  7,0
         USING *,7
         SSP   0(136,0),SCRPAD         SAVE SCRATCHPAD
         MVC   SCRPAD+156(4),4(0)      PUT BACK OLD VALUE OF GR7 OF P3
         LSP   12(3,0),PFOURR
         LM    8,9,REGS                P3 IMR & ISR
         PC    *+4,2
         SLR   11,11
         LR    12,11
         LR    13,12
         LA    14,BLOCKS+2
         SLL   14,3                    R14=8*PAGES = NO OF STORE KEYS
ISKLOOP  ISK   13,12
         STC   13,SKEYS(11)
         LA    11,1(11)
         LA    12,512(12)
         BCT   14,ISKLOOP              COLLECT ALL STORAGE KEYS
         LA    11,SKIP
         ST    11,CAW                  SAVE ADDR OF SKIP CCWS
         LH    12,2(0)                 DEVICE ADDR
         BAL   13,EXECUTE
         LA    11,WRITE
         ST    11,CAW                  ADDR OF WRITE CCW
         L     14,WRITE
         LA    11,BLOCKS               NO OF STORE BLOCKS
WRLOOP   BAL   13,EXECUTE
         A     14,FOURK
         ST    14,WRITE
         SR    15,15
         NC    0(1,14),0(14)
         BC    0,0
         C     15,NINE2
         BC    8,*+8
         BCT   11,WRLOOP
         LA    11,FBLKL                SIZE OF KEYS +SCPAD
         STH   11,WRITE+6
         LA    11,SCRPAD
         ST    11,WRITE
         MVI   WRITE,3
         BAL   13,EXECUTE
         LA    11,REWIND
         ST    11,CAW
         BAL   13,EXECUTE              REWIND TAPE
         LA    11,8(11)
         ST    11,72
         SDV   0(12)                   UNLOAD TAPE
         IDL   0
PFOUR    PC    PFOUR,1
EXECUTE  MVC   72(4,0),CAW             MOVE IN CAW
         SDV   0(12)                   START IPL DEVICE
         BNE   *-4                     LOOP TILL IT STARTS
         TDV   0(12)                   TEST DEVICE
         BNE   *-4                     LOOP TILL IT STOPS
         BR    13
CAW      DC    F'0'
FOURK    DC    F'4096'
REGS     DC    F'-1'
         DC    F'0'
NINE2    DC    F'92'
PFOURR   DC    A(PFOUR-PROGRAM+4096)
         DC    2F'0'
CONTROL  DC    X'20'
TM       DC    X'40'
SKIP     CCW   5,4096,X'70',0
         CCW   5,4096,X'70',0          SKIP FIRST BLOCK
         CCW   5,4096,X'30',0          SKIP SECOND BLOCK
WRITE    CCW   3,8192,0,4096           WRITE A BLOCK
REWIND   CCW   7,TM-PROGRAM+4096,0,1
         CCW   7,CONTROL-PROGRAM+4096,0,1   UNLOAD TAPE
SCRPAD   DC    136F'0'
SKEYS    DC    512F'0'                 ENOUGH SPACE FOR 1 MEG M/C
         DS    0D
LDATA    DC    F'6'
         DC    6F'0'
LPL      EQU   LDATA-PROGRAM
B2       EQU   BLOCKS+BLOCKS
B4       EQU   B2+B2
B8       EQU   B4+B4
SKEYSL   EQU   B8+16
FBLKL    EQU   SKEYSL+544
BOTTOM   DS    0D
         END