*        PURPOSE: TO EXERCISE REGISTER BLOCK 1.
*                 THIS PROGRAM DOES NOT BOTHER THE COC
*                 USAGE OF THE REGISTER BLOCK.
*        OUTPUTS: 'REG1 HERE' AT PROGRAM INITIATION.
*                 'REG1 ERROR DETECTED' IF A MISCOMPARE
*                 OCCURS.
*        A SNAP OF THE FAILING REGISTERS GOES TO THE
*        LINE PRINTER (GHOST AND BATCH) AND TO
*        THE USERS CONSOLE(ONLINE)
* THIS EXERCISER REQUIRES C0 PRIVLEDGE TO RUN
         SYSTEM SIG7FP
         SYSTEM   BPM
         BOUND    8
PSD0     GEN,12,20,32    X'C',ER020,0    MAPPED, SLAVE, REG BLK 0
PSD1     GEN,12,20,8,24  X'4',X010,7,X'10'  MAP, MSTR, BLK 1, INHIBITED
PSD2     GEN,12,20,32    X'C',START2,0    MAPPED, SLAVE, REG BLK 0
VAL1     DATA     X'F800F800'
LOOPCNT  DATA    100
VAL2     DATA     X'F800F800'
REGS     RES      16                REG SAVE AREA
TCON     TEXTC    'REG1 ON'
TCERR    TEXTC    'REG1 ERROR DETECTED'
START    M:TYPE       (MESS,TCON)
         M:WAIT   1
         LW,1     VAL1
         STW,1    VAL2
         LPSD,10  PSD1              GO TO REG BLK 1
X010     EQU      $
         DO       16
         LW,($-X010)/3   VAL1
         MTH,1    VAL1
         MTW,1    VAL1
         FIN
X020     EQU      $
         DO 16
         CW,($-X020)/5    VAL2      CHECK REG AGAINST VAL2
         BE       $+2               BE; OK, CHECK NEXT
         B        ER010             B; NO MATCH, ERROR
         MTH,1    VAL2
         MTW,1    VAL2
         FIN
         MTH,1    VAL1              INC LH OF VAL1
         MTW,1    VAL1              INC RH OF VAL1
         MTH,1    VAL2
         MTW,1    VAL2
         BGZ      X010              BGZ; KEEP ITERATING
         LI,1     100               L/100; RESET LOOP COUNTER
         STW,1    LOOPCNT           S/LOOP COUNTER
         LPSD,10  PSD2              GO SLAVE, MAPPED TO START2
ER010    LCI      0                 CC'S FOR STM
         STM,0    REGS              SAVE REGS
         LPSD,10  PSD0              GO TO REG BLK 0
ER020    LM,0     REGS              RESTORE REGS
         M:SNAP   'ERR',(VAL1,VAL2) SNAP
         M:TYPE    (MESS,TCERR)
         B        START2            CONTINUE
         END      START
