*M* SNAP PROCESS SNAP/SNAPC/IF/AND/OR/COUNT DEBUG CALS.
         DEF      SNAP:             XDELTA LABEL FOR SNAP MODULE.
SNAP:    EQU      %
*P*      NAME:    SNAP
*P*
*P*      PURPOSE: TO PROCESS DEBUG CALS -- M:SNAP, M:SNAPC, M:IF,
*P*               M:AND, M:OR, M:COUNT.  THESE CALS ARE BUILT BY
*P*               RUNNER FROM !SNAP,ETC. CARDS OR ARE CODED
*P*               DIRECTLY BY USERS INTO THEIR PROGRAMS.
*P*
*P*  DESCRIPTION: SNAP IS PASSED THE ADDRESS OF A DEBUG-CAL FPT.
*P*               IT ANALYZES THE FPT, SETS OR CLEARS DUMP FLAGS,
*P*               CAUSES A SNAP DUMP TO BE MADE IF APPROPRIATE,
*P*               EXECUTES THE REPLACED USER INSTRUCTION IN THE
*P*               FPT, AND RETURNS.
*P*               THE SPECIAL ENTRY POINT DEBUGX1 EXECUTES THE
*P*               REPLACED USER INSTRUCTION FOR LOADER-BUILT
*P*               M:SEGLD CALS, AND IS CALLED FROM SEGLD.
*P*
*P*    REFERENCE: CP-V BP/REF MANUAL FOR DESCRIPTION OF DEBUG CAL
*P*               FPT FORMATS AND USAGE.
*P*
BITS     SET      1                 GET DEFINITIONS OF XN,YN,MN.
         SYSTEM   UTS
         PCC      0
         PAGE
         DEF      DEBUGX1     ENTRY FROM M:SEGLD (LOADER-BUILT)
         DEF      MDEBUG      ENTRY FOR PROCESSING DEBUG CALS.
*
         REF      CKLIMIT     ROUTINE RETURNS MAX PROT TYPE OF MEMORY
         REF      DUMPW       ROUTINE DUMPS CONTENTS&ADDRESSES OF MEM
         REF      FINDDO      ROUTINE FINDS M:DO DCB ADDRESS.
         REF      GMB         ROUTINE GETS 34-WORD BUFFER FROM MPOOL
         REF      PRINTV      ROUTINE PRINTS LINE GIVEN BUFFER, #CHAR
         REF      REGPRNT     ROUTINE PRINTS USER'S REGISTERS
         REF      RMB         ROUTINE RETURNS 34-WORD BUFFER TO MPOOL
         REF      T:ABORTM    ROUTINE ABORTS USER (NO RETURN)
         REF      T:IACU      ROUTINE RETURNS PROT TYPE OF PAGE
         PAGE
*                 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
         PAGE
*                 PARAMETERS DEFINING POSITION IN PLIST RELATIVE TO
*                 R7
*
CNTR     EQU      3
STOPC    EQU      1
STRTC    EQU      0
STEPC    EQU      2
FLAG     EQU      6
LINK     EQU      -1
FROM     EQU      0
LFTW     EQU      0
RTW      EQU      1
TSTW     EQU      2
INST     EQU      4
         PAGE
*F*      NAME:    MDEBUG
*F*      PURPOSE: MDEBUG PROCESSES DEBUG CALS -- M:SNAP, ETC.
*F*
*D*      NAME:    MDEBUG
*D*      REGISTERS: ALL ARE VULNERABLE.
*D*      CALL:    BAL,R11 MDEBUG.
*D*      INTERFACE: T:IACU AND PRINTING ROUTINES IN DUMP MODULE.
*D*      ENVIRONMENT: MASTER MAPPED.
*D*      INPUT:   R7-> SECOND WORD OF A DEBUG-CAL FPT. (WORD 1).
*D*                   THE FPT APPEARS AS FOLLOWS--
*DO*
*D*
*                        WD 0:
*                          BYTE 0 - CODE
*                          REM.   - LINK. 0 IF NO MORE. ELSE ADDR.
*                        WD 1:
*                          SNAP AND SNAPC - FROM
*                          IF,AND, OR     - LOAD LEFT MEMBER.
*                          COUNT          - NUMBER TO START COUNTER
*                        WD 2:
*                          SNAP AND SNAPC - TO
*                          IF,AND, OR     - LOAD RIGHT MEMBER.
*                          COUNT          - NUMBER TO STOP COUNTER
*                        WD 3:
*                          SNAP AND SNAPC - COMMENT
*                          IF,AND, OR     - RELATION TESTING INST.
*                          COUNT          - INTERVAL AT WHICH TO SNAP
*                        WD 4:
*                          SNAP AND SNAPC - COMMENT AND REG SPEC.
*                          COUNT          - COUNTER
*                        WD 5:
*                          REPLACED INSTRUCTION
*                        WD 6:
*                          B  Z+1   Z IS LOC OF CAL1,3
*                        WD 7:
*                          FLAG WORD. FLAG IF B0 = 1. ADDRESS OF FLAG
*                          IF B0 = 0. FLAG IS B31 OF FLAG.
*FIN*
*D*               RETURN ADDRESS IS ON TOP OF STACK.
*D*      OUTPUT:  NONE.  (RETURN ADDRESS PULLED).
*D*      DESCRIPTION: MDEBUG DECIDES WHICH DEBUG CAL THIS IS AND
*D*               GOES TO THE PROPER ROUTINE.  THE INDIVIDUAL ROUTINES
*D*               FOR ALL BUT SNAP/SNAPC DO THE PROPER MANIPULATIONS
*D*               AND MAY SET OR CLEAR A FLAG IN MEMORY.
*D*               SNAP/SNAPC WILL CALL REGPRNT AND DUMPW IN DUMP
*D*               MODULE TO PRODUCE A SNAP DUMP, AFTER GETTING AN
*D*               MPOOL BUFFER FOR DUMP'S USE.
*D*               THE INDIVIDUAL ROUTINES RETURN TO DEBUGX TO SEE IF
*D*               THERE ARE CHAINED DEBUG FPTS. IF SO, BACK TO MDEBUG;
*D*               IF NOT, ON TO DEBUGX1 TO EXECUTE THE INSTRUCTION
*D*               REPLACED BY THE DEBUG FPT.
MDEBUG   EQU      %
         LW,R1    LINK,R7           R1 = FPTCODE, LINKADDR.
         LB,R1    R1                R1 = FPTCODE.
         CI,R1    NDBGS             IS THIS A LEGAL FPT CODE...
         BL       DBGTV,R1          --->YES.
         B        ERRB003           --->NO. ERROR.
*                                   CODE:
DBGTV    B        MSNAP              00  M:SNAP
         B        MSNAPC             01  M:SNAPC
         B        MIF                02  M:IF
         B        MAND               03  M:AND
         B        MOR                04  M:OR
         B        MCOUNT             05  M:COUNT
NDBGS    EQU      %-DBGTV
         PAGE
*E*      ERROR:   B0-01.
*E*      MESSAGE:   ATTEMPT TO DUMP AN INACCESSIBLE LOCATION.
*E*      DESCRIPTION:  A SNAP OR SNAPC FPT INCLUDED A LOCATION WITH
*E*               11 (NO-ACCESS) PROTECTION BETWEEN ITS FROM AND TO
*E*               ADDRESSES.
*E*      REGISTERS:  N/A.
ERRB001  LI,R14   X'B001'
         B        %+2
*E*      ERROR:   B0-02.
*E*    MESSAGE:  INACCESSIBLE FLAG ADDRESS GIVEN ON CONDITIONAL DEBUG.
*E*      DESCRIPTION:  A COUNT,IF,AND OR OR FPT'S FLAG ADDRESS WAS IN
*E*               PROTECTION TYPE 10 OR 11.
*E*      REGISTERS:  N/A.
ERRB002  LI,R14   X'B002'
         B        %+2
*E*      ERROR:   B0-03.
*E*      MESSAGE:  ILLEGAL PARAMETER IN DEBUG CAL.
*E*      DESCRIPTION:  IN AN IF, AND, OR OR FPT, A LOAD INSTRUCTION
*E*               WAS NOT LD,LW,LH,LB OR THE TEST INSTRUCTION WAS NOT
*E*               BCR,BCS.  OR A DEBUG FPT OR CHAINED FPT CONTAINED
*E*               AN ILLEGAL FPT CODE.  OR THERE WERE MORE THAN 255
*E*               DEBUG FPTS IN THE CHAIN.
*E*      REGISTERS:  N/A.
ERRB003  LI,R14   X'B003'
         SCS,R14  -8                R14 NOW SET FOR T:ABORTM.
         B        T:ABORTM          ---> GO ABORT USER.
         PAGE
*                 EXIT FROM PROCESSING DEBUG STATEMENT. CHECK FOR MORE.
*                 IF NONE, EXECUTE REPLACED INSTRUCTION AND EXIT.
*
DEBUGX   LC       *TSTACK
         BCS,8    DEBUGX20          CHECKED ALREADY
         LI,0     255
         LW,2     7
         AI,2     -1
DEBUGX10 LW,2     0,2               GET NEXT LINK
         AND,2    M17               CLEAR BAD BITS
         BEZ      DEBUGX20          NO MORE, OK
         BDR,0    DEBUGX10          LUPE FOR MAX
         B        ERRB003           ABORT, BAD LINK
*
DEBUGX20 LCI      8
         STCF     *TSTACK
         LW,R1    LINK,R7
         AND,R1   M17
         BEZ      DEBUGX1
*                 GET NEXT PLIST AND DECODE IT.
         AI,R1    1
         LW,R7    R1
         B        MDEBUG            ---> GO DO IT.
*                 FINISHED, EXIT.
DEBUGX1  LW,R1    INST,R7
         LB,R2    R1
         AND,R2   M7
         LW,R0    R7
         AI,R0    INST              CAL RETURNS HERE IF NOT BAL
         CI,R2    X'67'             EXU INSTRUCTION
         BNE      DEBUGX2           NO
         BAL,R11  GTEADD            YES-GET THE EFFECTIVE ADD OF EXU
         LW,R1    *R0
         LB,R2    R1
         AND,R2   M7
         LW,R0    R7
         AI,R0    INST              CAL RETURNS HERE IF NOT BAL
DEBUGX2  CI,R2    X'6A'             BAL INSTRUCTION
         BNE      DEBUGX3           NO
         BAL,R11  GTEADD            YES-GET THE EFFECTIVE ADD. OF BAL
         SLS,R1   -20
         AND,R1   M4                REGISTER OF BAL
         LW,R12   TSTACK+2          CAL ADDRESS
         AI,R12   +1                +1
         AND,R12  M17
         STW,R12  TSTACK+5,R1       TO BAL REG AS RETURN ADDRESS.
DEBUGX3  AI,R0    -1                BALANCE TRAPEXIT'S +1
         LI,R1    X'1FFFF'
         STS,R0   TSTACK+2          RETURN TO REPLACED INSTRUCTION
         PULL     11
         B        *11
         PAGE
*                 M:COUNT.  PROCESS THE COUNT PROCEDURE AND
*                   SET OR CLEAR FLAG AS APPROPRIATE.
MCOUNT   LW,R3    CNTR,R7
         AI,R3    +1                R3 = NEW COUNT.
         CW,R3    STOPC,R7            IF COUNT IS FINISHED,
         BG       CLEARF            ---> JUST SAY 'NO'.
         ANLZ,R1  %+2
         BAL,R4   CHKADD              MAKE SURE IT'S OKAY TO STORE,
         STW,R3   CNTR,R7             THEN STORE UPDATED COUNT.
         SW,R3    STRTC,R7          R3 = TICKS SINCE START.
         BLZ      CLEARF            ---> SAY 'NO' IF NOT YET TO START.
         LI,R2    0
         DW,R2    STEPC,R7
         AI,R2    0                   SEE IF WE ARE =ZERO MOD STEPPER.
         BNEZ     CLEARF            ---> SAY 'NO' IF NOT EVEN DIV.
         B        SETF              ---> SAY 'YES' IF EVEN DIV.
         SPACE    5
*                 M:OR.  IF FLAG SET, EXIT.  ELSE LIKE M:IF.
MOR      BAL,R11  TFLAG
         B        MIF               --->FLAG CLEAR.
         B        DEBUGX            --->FLAG SET.
         SPACE    5
*                 M:AND.  IF FLAG CLEAR, EXIT.  ELSE LIKE M:IF.
MAND     BAL,R11  TFLAG
         B        DEBUGX            --->FLAG CLEAR.
*        V        V                 ---VFLAG SET.
         SPACE    3
*                 M:IF.  SET OR CLEAR FLAG ACCORDING TO CONDITION.
MIF      LW,R1    LFTW,R7             GET FIRST LOAD INSTRUCTION.
         BAL,R11  GETOPD            R14/15= OPERAND OF FIRST LOAD.
         PUSH     2,R14               SAVE IT.
         LW,R1    RTW,R7              GET SECOND LOAD INSTRUCTION.
         BAL,R11  GETOPD            R14/15= OPERAND OF SECOND LOAD.
         PULL     2,R12             R12/13= OPERAND OF FIRST LOAD.
         LW,R4    Y7FF
         AND,R4   TSTW,R7
         LB,R2    R4                OP CODE OF BRANCH
         CI,R2    X'68'             BCR
         BE       %+3               YES-O.K.
         CI,R2    X'69'             BCS
         BNE      ERRB003           NO-BAD CAL
         AI,R4    SETF
         CD,R12   R14
         EXU      R4                --->SETF IF CONDITION TRUE.
*        V        V                 ---VCLEARF IF CONDITION FALSE.
         SPACE    3
*                 CLEAR FLAG.  SET FLAG=0.
CLEARF   LI,R3    0
         B        %+2
*                 SET FLAG.  SET FLAG=1.
SETF     LI,R3    1
*
         LW,R1    FLAG,R7           R1 = FLAG ADDRESS.
         BLZ      %+2               --->IF INDIRECT, WE GOT IT.
         ANLZ,R1  %-2                 OTHERWISE IT'S IMMEDIATE.
         BAL,R4   CHKADD              MAKE SURE IT'S OKAY TO STORE,
         STW,R3   0,R1                THEN STORE VALUE IN FLAG.
         B        DEBUGX            --->ALL DONE WITH DBUG NOW.
         SPACE    5
*                 CHECK FLAG.  RETURN +0 IF CLEAR, +1 IF SET.
TFLAG    LW,R2    FLAG,R7             GET FLAG
         BGEZ     %+2               --->GOT IT.
         LW,R2    0,R2                GOT IT INDIRECT.
         AND,R2   X1                  GET FLAG AS 0 OR 1.
         B        *R11,R2           --->RETURN +0 OR +1.
         PAGE
*                 M:SNAPC.  IF FLAG SET, SNAP.  ELSE EXIT.
MSNAPC   BAL,R11  TFLAG
         B        DEBUGX            --->FLAG CLEAR.
*        V        V                 ---VFLAG SET.
*                 M:SNAP.  SNAP SPECIFIED AREA.
MSNAP    BAL,R4   FINDDO              LOOK FOR M:DO DCB.
         BEZ      DEBUGX            --->NO M:DO MEANS NO SNAPS.
*                                   R6 =>M:DO DCB.
         LI,R12   X'130'
         AND,R12  0,R6
         PUSH     R12                 REMEMBER VFC & BTD OF M:DO.
         LI,R12   X'100'
         LI,R13   X'130'              SET TO VFC & BTD=0.
         STS,R12  0,R6
         PUSH     R7                R7 =>M:SNAP FPT +1.
         BAL,R11  GMB               R14=>BUFFER FOR PRINTING SNAP.
         BEZ      %-1               --->BE SURE TO GET A BUFFER.
         LW,R0    BLKS
         LCI      2                 R0/R1/R2 =
         LM,R1    FROM+2,R7             USER SNAP MESSAGE.
         LCI      3
         STM,R0   *R14                PUT INTO BUFFER.
         LI,R15   12                R15= MESSAGE LENGTH.
         BAL,R12  PRINTV              PRINT USER SNAP MESSAGE.
         LW,R7    -1,R7             PICK UP FIRST WORD OF FPT
         CI,R7    X'20000'          PSD/REGS DUMP SUPPRESSED?
         BANZ     MSNAP30           YES, SKIP THIS
         LI,R10   TSTACK+20         R10=>USER R15.
         BAL,R11  REGPRNT             DUMP USER'S PSD & REGISTERS.
MSNAP30  EQU      %
         LW,R7    *TSTACK           R7 =>M:SNAP FPT+1 AGAIN.
         LW,R8    FROM,R7           R8 = START ADDRESS OF SNAP.
         BGEZ     MSNAP40           --->GOT IT.
         CI,R8    X'1FFF0'            INDIRECT. THRU REG...
         BANZ     %+2               --->NO.
         AI,R8    TSTACK+5            YES. ADJUST IT.
         LW,R8    *R8                 GO INDIRECT.
MSNAP40  AND,R8   M17               R8 = START ADDRESS OF SNAP.
         LW,R9    FROM+1,R7         R9 = FINISH ADDRESS OF SNAP.
         BGEZ     MSNAP50           --->GOT IT.
         CI,R9    X'1FFF0'            INDIRECT. THRU REG...
         BANZ     %+2               --->NO.
         AI,R9    TSTACK+5            YES. ADJUST IT.
         LW,R9    *R9                 GO INDIRECT.
MSNAP50  AND,R9   M17               R9 = FINISH ADDRESS OF SNAP.
         LW,R7    R8                  GET START ADDRESS.
         LW,R15   R9
         SW,R15   R8
         BLZ      MSNAP70           --->NOTHING TO SNAP.
         SLS,R15  2                 R15= # BYTES.
         BAL,R0   CKLIMIT             FIND MAX PROT TYPE.
         BCR,2    MSNAP60           --->MAX PROT 00/01 OKAY.
         BCR,1    MSNAP60           --->MAX PROT 10    OKAY.
         BAL,R11  RMB                 BAD NEWS.  FREE UP MPOOL.
         B        ERRB001           --->OFF TO T:ABORTM.
MSNAP60  BAL,R11  DUMPW               DUMP THE SNAP STUFF.
         BAL,R11  RMB                 FREE THE PRINT BUFFER
MSNAP70  PULL     R7                R7 =>SNAP FPT+1 AGAIN.
         PULL     R12
         LI,R13   X'130'              RESTORE VFC & BTD TO M:DO.
         STS,R12  0,R6
         B        DEBUGX            --->DONE WITH SNAP.
         PAGE
*        BAL,R11  GETOPD            GET OPERAND - LOAD INSTR ONLY
*                 R1                INSTRUCTION
*                 R14,R15  OUT      OPERAND
GETOPD   PUSH     R11                 SAVE RETURN ADDRESS.
         PUSH     R7                  PRESERVE R7.
         LW,R2    Y00E
         LW,R3    Y00F
         STS,R2   R1                  CHANGE REG. TO R14.
         PUSH     R1
         LI,R2    4
         LB,R3    R1
         AND,R3   M7                  GET OPCODE.
         CB,R3    LDOPS,R2
         BE       GETOPD2           --->IT'S A LOAD.
         BDR,R2   %-2
         B        ERRB003           --->IT'S NOT A LOAD.  ABORT.
GETOPD2  LCI      0
         LM,R0    TSTACK+5            LOAD USER REGISTERS.
         EXU      *TSTACK             FETCH THE OPERAND.
         PULL     R1
         LB,R3    R1
         AND,R3   M7                  GET OPCODE AGAIN.
         CI,R3    X'12'
         BE       %+2                 IF IT'S NOT LOAD DOUBLEWORD,
         LI,R15   0                   CLEAR OTHER REGISTER.
         PULL     R7                  RESTORE R7.
         PULL     R11                 RESTORE RETURN
         B        *R11              ---> AND RETURN TO CALLER.
         SPACE    3
*        BAL,R11  GTEADD            GET EFFECTIVE ADDR OF INSTRUCTION
*                 R1                INSTRUCTION
*                 R0       OUT      EFFECTIVE ADDRESS
GTEADD   PUSH     R11                 SAVE RETURN ADDRESS.
         PUSH     R7                  SAVE R7
         PUSH     R1
         LCI      0
         LM,R0    TSTACK+5            LOAD USER REGISTERS.
         ANLZ,R0  *TSTACK             GET EFFECTIVE ADDRESS.
         PULL     R1
         PULL     R7                  RESTORE R7.
         PULL     R11                 RESTORE RETURN ADDRESS.
         B        *R11              ---> AND RETURN TO CALLER.
         SPACE    3
*        BAL,R4   CHKADD            CHECK ADDRESS.
*                 R1                ADDRESS TO CHECK.
*        ZAP R11                    ABORT IF NOT IN 00 OR 01.
CHKADD   PUSH     R7                   PRESERVE R7.
         LW,R7    R1
         SLS,R7   -9                R7 = PAGE ADDRESS IS IN.
         BAL,R11  T:IACU              GET PROTECTION OF PAGE IN CC.
         BCS,2    ERRB002           --->PROT 10/11 BAD. GO ABORT.
         PULL     R7                    PROT 00/01 OK.  RESTORE R7.
         B        0,R4              ---> RETURN TO CALLER.
         PAGE
LDOPS    DATA     X'00327252',X'12000000'
Y00E     DATA     X'00E00000'
Y00F     DATA     X'00F00000'
Y7FF     DATA     X'7FF00000'
BLKS     DATA     X'C3404040'
         END

